[编程交流] Cary Hulse项目

(defun c:attpop (/ *error* StrBrk                 
                  ALST ATT BNME DDEL DOC FILE LST NL OBJ OFILE PT SPC UFLAG X Y )
 
 ;; by Lee Mac ~ 01.01.10
 ;; --{ Commented Version }--
 
 (vl-load-com) ;; Load Visual LISP Console
 
 ;; --{  Error Handler Function  }--
 (defun *error* (msg)  ;; Localised with variables
   
   (and ofile (close ofile)) ;; If ofile still non-nil, close the open file
   
   (and uflag (vla-EndUndoMark doc))  ;; If uflag still non-nil, End the Undo Mark.
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")  ;; Suppress Cancel messages
       
       (princ (strcat "\n** Error: " msg " **"))) ;; Print fatal errors
   
   (princ))
 ;; -----------------------------------------------
 ;; --{  StrBrk Function  }--
 ;; By Lee Mac  ~  Used to break a string into a list of elements,
 ;;                using a delimiter.
 (defun StrBrk (str chrc / pos lst)
   (while (setq pos (vl-string-position chrc str))
     (setq lst (cons (substr str 1 pos) lst)
           str (substr str (+ pos 2))))
   (reverse (cons str lst)))
 ;; -----------------------------------------------
 
 (if (and
       ;; Block selection
       (setq bNme (getfiled "Select Block to Insert" (cond (*block_file*) ("")) "dwg"     16))
       ;; Data File Selection
       (setq file (getfiled "Select Input File"      (cond (*load_file*)  ("")) "txt;csv" 16)))
   
   (progn
     ;; Start the Undo Mark before we proceed uflag = T
     
     (setq uflag (not (vla-StartUndoMark
                        (setq doc (vla-get-ActiveDocument
                                    (vlax-get-acad-object)))))
           ;; Get the Active Space
           spc (if (zerop (vla-get-activespace doc))
                 (if (= (vla-get-mspace doc) :vlax-true)
                   (vla-get-modelspace doc)
                   (vla-get-paperspace doc))
                 (vla-get-modelspace doc)))
     ;; Get the correct delimiter, if CSV, comma, else space.
     
     (setq dDel (if (eq ".CSV" (vl-filename-extension file)) 44 32)
           ;; Save the defaults for next time, and open the file, ofile = non-nil
           
           *block_file* bNme *load_file* file ofile (open file "r"))
     ;; Read the file and break the strings
     (while (setq nl (read-line ofile))
       (setq lst (cons (StrBrk nl dDel) lst)))
     ;; Close the file, ofile = nil  and reverse the lst.
     
     (setq ofile (close ofile) lst (reverse lst))
     ;; While there are attribs in the list, AND the user has clicked a point
     (while (and (setq x  (car lst))
                 (setq pt (getpoint "\nSpecify Point for Block: ")))
       ;; Catch any errors that occur when inserting the block
       
       (if (vl-catch-all-error-p
             (setq obj
               (vl-catch-all-apply (function vla-InsertBlock)
                 (list spc (vlax-3D-point pt) bNme 1. 1. 1. 0.))))
         
         (princ "\n** Error Inserting Block **")
         ;; Else populate the Attribs using the values in the list.
         (progn
           ;; Get a list of VLA-objects (attribs)
           (setq aLst (vlax-invoke obj 'GetAttributes))
           ;; While there is an attrib and value
           (while (and (setq y   (car x))
                       (setq att (car aLst)))
             
             ;; Populate the attribs
             (vla-put-TextString att y)
             (setq x (cdr x) aLst (cdr aLst)))))
       ;; Move onto next item
       (setq lst (cdr lst)))
     ;; End the Undo Mark,  uFlag = nil
     (setq uFlag (vla-EndUndoMark doc))))
 ;; Clean exit
 (princ))

(progn
           ;; Get a list of VLA-objects (attribs)
           (setq aLst (vlax-invoke obj 'GetAttributes)) ;;Can I assign this to the attribute tag "TREE#"?
           ;; While there is an attrib and value
           (while (and (setq TRNUM   (car x))
                       (setq att (car aLst))
  ;;;set variables for dynamic values, not sure if this is in the correct place?
  (setq CANOP (cadr x))
  (setq CRZ (caddr x))
  (setq CRD (cadddr x))
 );end and
             
             ;; Populate the attribs
             (vla-put-TextString att TRNUM)
             ;;(setq x (cdr x) aLst (cdr aLst));;;edited by CH - only one attribute in block
      
;;;Set Dynamic Properties using "myModifyBk" function
(myModifyBk (list "CRD Radius" CRD)) 
(myModifyBk (list "CRZ Radius" CRZ))
(myModifyBk (list "Canopy Radius" CANOP))
     
);end while
 );end progn

(setq file (getfiled "Select Input File"      (cond (*load_file*)  ("")) "txt;csv" 16)))