炸开所有的匿名块

Lisphk · 发表于 2017-6-18 23:46:07

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:ExplAnon ( / *error* _StartUndo _EndUndo _UnlockLayers _RelockLayers _i**plodable _GetBlockName acblk acdoc locked name ss )
(defun *error* ( msg )
(if locked (_RelockLayers locked))
(if acdoc (_EndUndo acdoc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
)
(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)
(defun _UnlockLayers ( doc / l )
(vlax-for layer (vla-get-layers doc)
(if (eq :vlax-true (vla-get-lock layer))
(vla-put-lock (car (setq l (cons layer l))) :vlax-false)
)
)
l
)
(defun _RelockLayers ( lst )
(mapcar '(lambda ( l ) (vla-put-lock l :vlax-true)) lst)
)
(defun _i**plodable ( blockdef )
(or
(not (vlax-property-available-p blockdef 'explodable))
(eq :vlax-true (vla-get-explodable blockdef))
)
)
(defun _GetBlockName ( obj )
(if (vlax-property-available-p obj 'effectivename)
(vla-get-effectivename obj)
(vla-get-name obj)
)
)
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
acblk (vla-get-blocks acdoc)
)
(if (ssget "_X" '((0 . "INSERT") (2 . "`*U*")))
(progn
(_StartUndo acdoc) (setq locked (_UnlockLayers acdoc))
(vlax-for obj (setq ss (vla-get-ActiveSelectionSet acdoc))
(if (_i**plodable (vla-item acblk (setq name (_GetBlockName obj))))
(progn
(vla-explode obj) (vla-delete obj)
)
(princ (strcat "\nBlock: " name " is not explodable."))
)
)
(vla-delete ss) (_RelockLayers locked) (_EndUndo acdoc)
)
)
(princ)
)

(defun c:ExplAnon ( / *error* _StartUndo _EndUndo _UnlockLayers _RelockLayers _i**plodable _GetBlockName acblk acdoc locked name ss ) 
  (defun *error* ( msg ) 
    (if locked (_RelockLayers locked)) 
    (if acdoc  (_EndUndo acdoc)) 
    (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") 
        (princ (strcat "\n** Error: " msg " **"))) 
    (princ) 
  ) 
 
  (defun _StartUndo ( doc ) (_EndUndo doc) 
    (vla-StartUndoMark doc) 
  ) 
 
  (defun _EndUndo ( doc ) 
    (if (= 8 (logand 8 (getvar 'UNDOCTL))) 
      (vla-EndUndoMark doc) 
    ) 
  ) 
 
  (defun _UnlockLayers ( doc / l ) 
    (vlax-for layer (vla-get-layers doc) 
      (if (eq :vlax-true (vla-get-lock layer)) 
        (vla-put-lock (car (setq l (cons layer l))) :vlax-false) 
      ) 
    ) 
    l 
  ) 
 
  (defun _RelockLayers ( lst ) 
    (mapcar '(lambda ( l ) (vla-put-lock l :vlax-true)) lst) 
  ) 
 
  (defun _i**plodable ( blockdef ) 
    (or 
      (not (vlax-property-available-p blockdef 'explodable)) 
      (eq :vlax-true (vla-get-explodable blockdef)) 
    ) 
  ) 
 
  (defun _GetBlockName ( obj ) 
    (if (vlax-property-available-p obj 'effectivename) 
      (vla-get-effectivename obj) 
      (vla-get-name obj) 
    ) 
  ) 
 
  (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) 
        acblk (vla-get-blocks acdoc) 
  )         
 
  (if (ssget "_X" '((0 . "INSERT") (2 . "`*U*"))) 
    (progn 
      (_StartUndo acdoc) (setq locked (_UnlockLayers acdoc)) 
       
      (vlax-for obj (setq ss (vla-get-ActiveSelectionSet acdoc)) 
         
        (if (_i**plodable (vla-item acblk (setq name (_GetBlockName obj)))) 
          (progn 
            (vla-explode obj) (vla-delete obj) 
          ) 
          (princ (strcat "\nBlock: " name " is not explodable.")) 
        ) 
      ) 
      (vla-delete ss) (_RelockLayers locked) (_EndUndo acdoc) 
    ) 
  ) 
 
  (princ) 
)

sh_h · 发表于 2017-6-19 09:28:17

这个程序非常实用，谢谢楼主分享！！！

账号		自动登录	找回密码
密码			立即注册

[每日一码] 炸开所有的匿名块

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。