[综合讨论] 插入块注意Lee M

;; Block Insertor by Lee McDonnell
;; 03.06.2009
(defun c:blkIns (/ doc spc bdef blk file ofile ex lst iBlk line)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; vPort
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 (setq bdef (getvar "INSNAME"))
 (while (not blk)
   (setq blk
     (getstring t
       (strcat "\nSpecify Block to be Inserted <" bdef ">: ")))
   (cond ((eq "" blk)
          (setq blk bdef))
         ((and (snvalid blk)
               (tblsearch "BLOCK" blk)))
         ((and (snvalid blk)
               (findfile (strcat blk ".dwg")))
          (command "_.insert" blk) (command))
         (T (princ "<!> Please Re-Select <!>")
          (setq blk nil bdef ""))))
 
 (if (setq file (getfiled "Select File to Read"
       (if *load$file* *load$file* "") "txt;csv" )
   (progn
     (setq *load$file* file ofile (open file "r")
           ex (vl-filename-extension file))
     (while (setq nl (read-line ofile))
       (setq lst (cons (StrBrk nl (if (eq ex ".txt") 32 44)) lst)))
     (close ofile)
     (foreach line lst
       (setq iBlk
         (vla-InsertBlock spc
           (vlax-3D-point
             (mapcar 'distof (list (car line) (cadr line) "0.0")))
           blk 1. 1. 1. 0.))      
       (if (and (eq :vlax-true (vla-get-HasAttributes iBlk))
                (setq line (cddr line)))
         (foreach att  (vlax-safearray->list
                         (vlax-variant-value
                           (vla-getAttributes iBlk)))
           (if line
             (vla-put-TextString att (car line)))
           (setq line (cdr line))))))
   (princ "\n<!> No File Selected <!>"))
 (princ))
     
(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)))