马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
- (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)
- )
|