[编程交流] 匹配块的特性

Command: mpr_block

(defun c:mpr_block (/              *kpblc-activedoc*
           selset          ent
           item          _kpblc-layer-status-restore
           _kpblc-layer-status-save
           *error*
           )
 (defun *error* (msg)
   (_kpblc-layer-status-restore)
   (vla-endundomark *kpblc-activedoc*)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (defun _kpblc-layer-status-restore (/ item)
   (if    *kpblc-list-layer-status*
     (progn
   (foreach item *kpblc-list-layer-status*
     (vla-put-layeron (car item) (cdr (assoc "on" (cdr item))))
     (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
     (if (not (equal (vla-get-activelayer *kpblc-activedoc*) (car item)))
       (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
       ) ;_ end of if
     ) ;_ end of foreach
   (setq *kpblc-list-layer-status* nil)
   ) ;_ end of progn
     ) ;_ end of if
   ) ;_ end of defun
 (defun _kpblc-layer-status-save (layers-on / item)
   (if    *kpblc-list-layer-status*
     (setq *kpblc-list-layer-status* nil)
     ) ;_ end of if
   (vlax-for item (vla-get-layers *kpblc-activedoc*)
     (setq *kpblc-list-layer-status*
        (append *kpblc-list-layer-status*
            (list
              (list item
                (cons "freeze" (vla-get-freeze item))
                (cons "lock" (vla-get-lock item))
                (cons "on" (vla-get-layeron item))
                ) ;_ end of list
              ) ;_ end of list
            ) ;_ end of append
       ) ;_ end of setq
     (if layers-on
   (progn
     (vla-put-layeron item :vlax-true)
     (vla-put-lock item :vlax-false)
     (if (not (equal (vla-get-activelayer *kpblc-activedoc*) item))
       (vla-put-freeze item :vlax-false)
       ) ;_ end of if
     ) ;_ end of progn
   ) ;_ end of if
     ) ;_ end of vlax-for
   ) ;_ end of defun
 (vl-load-com)
 (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark *kpblc-activedoc*)
 (if (and (setq ent (entsel "\nSelect the block for source prop <Exit> : "))
      (= (cdr (assoc 0 (entget (car ent)))) "INSERT")
      (setq ent (vlax-ename->vla-object (car ent)))
      ) ;_ end of and
   (progn
     (_kpblc-layer-status-save t)
     (if (setq selset (ssget '((0 . "INSERT"))))
   (while (and selset
           (> (sslength selset) 0)
           ) ;_ end of and
     (setq item (ssname selset 0))
     (ssdel item selset)
     (foreach prop    '("color"        "layer"          "xscalefactor"
             "yscalefactor"    "zscalefactor"    "rotation"
             "linetype"        "lineweight"      "linetypescale"
             )
       (if    (and (vlax-property-available-p ent prop t)
            (vlax-property-available-p (vlax-ename->vla-object item) prop t)
            ) ;_ end of and
         (vlax-put-property (vlax-ename->vla-object item) prop (vlax-get-property ent prop))
         ) ;_ end of if
       ) ;_ end of foreach
     ) ;_ end of while
   ) ;_ end of if
     (_kpblc-layer-status-restore)
     ) ;_ end of progn
   ) ;_ end of if
 (vla-regen *kpblc-activedoc* acactiveviewport)
 (vla-endundomark *kpblc-activedoc*)
 (princ)
 ) ;_ end of defun