请教高手，此块为何无法炸碎？谢谢
请教高手，此块为何无法炸碎？见附件。谢谢！！！可以啊.....................
帮你炸开了
本帖最后由 1291500406 于 2019-6-20 11:19 编辑cad2007运行这个，等两分钟就炸开了，
(defun c:bb()
(command "_audit" "y" )
(setq en(car (entsel)))
(command "_bedit"(cdr (assoc 2 (entget en))))
(command "EXPLODE"(ssget "x" ) "")
(command "_BCLOSE" "")
(command "EXPLODE"en "")(princ))
cad2017运行无效，这个是无名块，2017无法获取块名，你要先改块名
(defun C:blk~U (/ ss2 ss1*APP *DOC A AA apple_sel apple_nnblk i bbb)
(setq ss2 (uINT 1 "" "1.改成无名块，2.匿名块恢复为时间块名" 1))(if (= 1 ss2)
(prompt "\n选要改动无名块的图元:")(prompt "\n选要改动时间块名的图元:"))
(if (= 1 ss2)(setq A "*U")(setq A (rtos (* (getvar "CDATE") 1E8))))(setq AA 1bbb nil)
(if (setq ss1 (ssget (list (cons 0 "INSERT"))))(progn(setq osmode (getvar "osmode") i 0)
(setvar "osmode" 0)(vl-load-com)(setq *APP (vlax-get-acad-object) *DOC (vla-get-activeDocument *APP))
(while(setq apple_sel (ssname ss1 i))(if (= 1 ss2)(setq A "*U")(setq A (rtos (1+ (atof A)))))
(setq AA 0)(if (member (cdr (assoc 2 (entget apple_sel))) bbb)(setq AA 1)
(setq bbb (append bbb (list A))))(setq apple_nnblk (vlax-ename->vla-object apple_sel))
(if(and(= (vla-get-objectname apple_nnblk) "AcDbBlockReference")(= AA 0))
(vla-put-name(vla-item(vla-get-blocks(vla-get-activedocument (vlax-get-acad-object)))
(vla-get-name apple_nnblk)) A))(setq i (1+ i)))(if (= ss2 2)(progn(vla-auditinfo *Doc :vlax-true)
(setq A (rtos (* (getvar "CDATE") 1E8))i 0)(while(setq apple_sel (ssname ss1 i))
(if (= 1 ss2)(setq A "*U")(setq A (rtos (1+ (atof A)))))(setq apple_nnblk (vlax-ename->vla-object apple_sel))
(if (= (vla-get-objectname apple_nnblk) "AcDbBlockReference")
(vla-put-name(vla-item(vla-get-blocks(vla-get-activedocument (vlax-get-acad-object)))
(vla-get-name apple_nnblk))A)(princ "\n选择物体非块"))(setq i (1+ i)))))
(setvar "osmode" osmode)))(princ))(defun uint (bit kwd msg def / inp)
(if def (setq msg (strcat "\n" msg "<" (itoa def) ">:")bit (- bit (boole 1 bit 1)))
(if(= "" (substr msg (strlen msg) 1))(setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ":"))
(setq msg (strcat "\n" msg ":"))))(initget bit kwd)(setq inp (getint msg))(if inp inp def))
谢谢 1291500406 AutoCAD2020表示轻松炸开。
页:
[1]