;;;This function is a subroutine for "our" drawing stamp routine (lbl) defined in lbl.lsp ;;;It assigns to the variable ThisDwgImages a string value that is a list of images in the drawimg. ;;; ;;; AUTHOR: HENRY C. FRANCIS ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; All rights reserved without prejudice. ;;; ;;; Copyright: 2010 ;;; Last Edited: 2-24-2011 ;;; ;;;Requires rtext-images.dwg which contains an RTEXT image list. You can recreate it using the RTEXT command. ;;;Using the RTEXT image list directly as part of the stamp is unacceptable as it is a stacked list that ;;;would frequently extend into the drawing area. rtext-images.dwg is inserted and exploded twice leaving a ;;;stack of text lines containing image names. The text lines are read, concatenated into a single string ;;;which is assigned to a lisp variable 'ThisDwgImages', and then the text lines are deleted. ;;;The lisp variable is evaluated by the RTEXT of the drawing stamp (2nd line) to reconstruct the image list. ;;; (DEFUN getimages (Caller CmdSet / cnt this_insert this_rtext this_mtext this_text text_ss this_list text_ss_len) (SETQ image_list NIL) (SETQ rtext-images (FINDFILE "rtext-images.dwg")) (IF rtext-images (PROGN (COMMAND ".insert" "*rtext-images" (getvar "viewctr") 1.0 0.0 ) ;_ end of COMMAND (COMMAND ".explode" (SSGET "_X" '((0 . "Rtext") (1 . "IMAGES: $*")))) (COMMAND ".explode" (SSGET "P")) (SETQ text_ss (SSGET "P")) (SETQ cnt 0 text_ss_len (SSLENGTH text_ss) ) ;_ end of SETQ ;;; (IF str_to_list NIL (LOAD "str_to_list" "\nFile STR_TO_LIST.LSP not loaded! ")) (WHILE (< cnt text_ss_len) (SETQ this_ent (ENTGET (SSNAME text_ss cnt)) this_text (CDR (ASSOC 1 this_ent)) ) (WHILE (OR (WCMATCH this_text "*\\*@") (WCMATCH this_text "*/*@") ) (SETQ this_text (SUBSTR this_text 2)) ) (SETQ this_list (APPEND this_list (LIST this_text))) (ENTDEL (SSNAME text_ss cnt)) (SETQ cnt (1+ cnt)) ) (redraw) ;;; (SETQ this_list (str_to_list this_text "P " nil nil)) (FOREACH n this_list (IF (MEMBER n image_list) NIL (IF (WCMATCH n "IMAGES: *") (SETQ first_image (STRCAT (SUBSTR n 1 8))) (SETQ image_list (APPEND image_list (LIST n))) ) ) ) ;_ end of SETQ (IF first_image (SETQ image_list (CONS first_image image_list)) ) (IF image_list (SETQ thisdwgimages (SUBSTR (EVAL (CONS 'STRCAT (MAPCAR '(LAMBDA (x) (STRCAT ", " x) ) ;_ end of LAMBDA image_list ) ;_ end of MAPCAR ) ;_ end of CONS ) ;_ end of EVAL 3 ) ;_ end of SUBSTR ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of PROGN ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 0 0 0 T T nil T) ;*** DO NOT add text below the comment! ***|;