[编程交流] 块编辑Lisp

(vl-load-com)
(defun c:be (/ opt ss n)
 (setq *be:selection* nil)
 (if *be:reactor*
   (setq *be:reactor* (vlr-remove *be:reactor*))
 )
 (initget "-2d -3d Reference")
 (if (setq opt (nentselp "\nSelect block entity or [-2d/-3d/Ref]: "))
   (cond
     ((= (type opt) 'STR)
      (if (wcmatch opt "-2d,-3d")
        (setq opt (strcat "(Part Number)" opt))
      )
      (if (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 opt))))
        (progn
          (setq n (sslength ss))
          (while (>= (setq n (1- n)) 0)
            (setq *be:selection* (cons (ssname ss n) *be:selection*))
          )
          (VLR-Reaction-Set (setq *be:reactor* (vlr-editor-reactor "BE")) :vlr-commandEnded 'be:CallBack)
          (setq ss (ssadd (car *be:selection*)))
          (command "._ZOOM" "_Object" ss "")
          (c:BE1)
        )
      )
     )
     ((= (type opt) 'LIST)
      (command ".-RefEdit" opt "_Ok")
      (while (> (getvar "CMDACTIVE") 0) (command ""))
     )
   )
 )
 (princ)
)
(defun be:CallBack (ro ci / ss)
 (if (eq (strcase (car ci)) "REFCLOSE")
   (progn
     (setq ss (ssadd (car *be:selection*)))
     (or *ActiveDoc* (setq *ActiveDoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
     (sssetfirst nil ss)
     (vla-SendCommand *ActiveDoc* "._ZOOM\n_Object\n")
     (vla-SendCommand *ActiveDoc* "BE1\n")
   )
 )
 (if (and (not *be:selection*) *be:reactor*)
   (setq *be:reactor* (vlr-remove *be:reactor*))
 )
 (princ)
)
(defun c:BE1 (/ ss)
 (setq ss             (ssadd (car *be:selection*))
       *be:selection* (cdr *be:selection*)
 )
 (sssetfirst nil ss)
 (command ".-RefEdit" "_Ok")
 (while (> (getvar "CMDACTIVE") 0) (command ""))
)
;; Clear reactors
(setq rlst (vlr-reactors))
(foreach item rlst
 (foreach ro (cdr item)
   (if (= "BE" (vlr-data ro))
     (vlr-remove ro)
   ) ;_ end of if
 ) ;_ end of foreach
) ;_ end of foreach
(setq *be:selection* nil)

7