AUTOLISP转成VLISP代码
本帖最后由 artken 于 2011-3-20 04:38 编辑下面是ET工具里的分解属性块BURST命令（用AUTOLISP写的），作了点修改（改成是加载后自动选物体执行了）。;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;以下是函数定义;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun PBOBURST (/ item bitset bump att-text lastent burst-one burst
BCNT BLAYER BCOLOR ELAST BLTYPE ETYPE PSFLAG ENAME )
;-----------------------------------------------------
; Item from association list
;-----------------------------------------------------
(Defun ITEM (N E) (CDR (Assoc N E)))
;-----------------------------------------------------
; Error Handler
;-----------------------------------------------------
(acet-error-init
(list
(list "cmdecho" 0
"highlight" 1
)
T ;flag. True means use undo for error clean up.
);list
);acet-error-init
;-----------------------------------------------------
; BIT SET
;-----------------------------------------------------
(Defun BITSET (A B) (= (Boole 1 A B) B))
;-----------------------------------------------------
; BUMP
;-----------------------------------------------------
(Setq bcnt 0)
(Defun bump (prmpt)
(Princ
(Nth bcnt '("\r-" "\r\\" "\r|" "\r/"))
)
(Setq bcnt (Rem (1+ bcnt) 4))
)
;-----------------------------------------------------
; Convert Attribute Entity to Text Entity
;-----------------------------------------------------
(Defun ATT-TEXT (AENT / TENT ILIST INUM)
(Setq TENT '((0 . "TEXT")))
(ForEach INUM '(8
6
38
39
62
67
210
10
40
1
50
41
51
7
71
72
73
11
74
)
(If (Setq ILIST (Assoc INUM AENT))
(Setq TENT (Cons ILIST TENT))
)
)
(Setq
tent (Subst
(Cons 73 (item 74 aent))
(Assoc 74 tent)
tent
)
)
(EntMake (Reverse TENT))
)
;-----------------------------------------------------
; Find True last entity
;-----------------------------------------------------
(Defun LASTENT (/ E0 EN)
(Setq E0 (EntLast))
(While (Setq EN (EntNext E0))
(Setq E0 EN)
)
E0
)
;-----------------------------------------------------
; Burst one entity
;-----------------------------------------------------
(Defun BURST-ONE (BNAME / BENT ANAME ENT ATYPE AENT AGAIN ENAME
ENT SS-COLOR SS-LAYER SS-LTYPE mirror ss-mirror
mlast)
(Setq
BENT (EntGet BNAME)
BLAYER (ITEM 8 BENT)
BCOLOR (ITEM 62 BENT)
BCOLOR (Cond
((> BCOLOR 0) BCOLOR)
((= BCOLOR 0) "BYBLOCK")
("BYLAYER")
)
BLTYPE (Cond ((ITEM 6 BENT)) ("BYLAYER"))
)
(Setq ELAST (LASTENT))
(If (= 1 (ITEM 66 BENT))
(Progn
(Setq ANAME BNAME)
(While (Setq
ANAME (EntNext ANAME)
AENT(EntGet ANAME)
ATYPE (ITEM 0 AENT)
AGAIN (= "ATTRIB" ATYPE)
)
(bump "正在转换属性")
(ATT-TEXT AENT)
)
)
)
(Progn
(bump "分解块")
(acet-explode BNAME)
;(vla-explode (vlax-ename->vla-object BNAME))
;(command "_.explode" bname)
)
(Setq
SS-LAYER (SsAdd)
SS-COLOR (SsAdd)
SS-LTYPE (SsAdd)
ENAME ELAST
)
(While (Setq ENAME (EntNext ENAME))
(bump "收集片")
(Setq
ENT (EntGet ENAME)
ETYPE (ITEM 0 ENT)
)
(If (= "ATTDEF" ETYPE)
(Progn
(If (BITSET (ITEM 70 ENT) 2)
(ATT-TEXT ENT)
)
(EntDel ENAME)
)
(Progn
(If (= "0" (ITEM 8 ENT))
(SsAdd ENAME SS-LAYER)
)
(If (= 0 (ITEM 62 ENT))
(SsAdd ENAME SS-COLOR)
)
(If (= "BYBLOCK" (ITEM 6 ENT))
(SsAdd ENAME SS-LTYPE)
)
)
)
)
(If (> (SsLength SS-LAYER) 0)
(Progn
(bump "固定图层")
(Command
"_.chprop" SS-LAYER "" "_LA" BLAYER ""
)
)
)
(If (> (SsLength SS-COLOR) 0)
(Progn
(bump "固定颜色")
(Command
"_.chprop" SS-COLOR "" "_C" BCOLOR ""
)
)
)
(If (> (SsLength SS-LTYPE) 0)
(Progn
(bump "固定线型")
(Command
"_.chprop" SS-LTYPE "" "_LT" BLTYPE ""
)
)
)
)
;-----------------------------------------------------
; BURST MAIN ROUTINE
;-----------------------------------------------------
(Defun BURST (/ SS1)
(setq PSFLAG (if (= 1 (caar (vports)))
1 0
)
)
(pbossget);;;;自动选择要分解的物体
(If SS1
(Progn
(Setvar "highlight" 0)
(terpri)
(Repeat
(SsLength SS1)
(Setq ENAME (SsName SS1 0))
(SsDel ENAME SS1)
(BURST-ONE ENAME)
)
(princ "\n")
)
)
)
;-----------------------------------------------------
; BURST COMMAND
;-----------------------------------------------------
(BURST)
(acet-error-restore)
);end defun
(princ)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;函数定义完毕;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;第一步:分解属性块
(princ "{开始分解属性块，耐心等待...}")
(defun pbossget ()
(Setq SS1 (SsGet "X" (list (cons 0 "INSERT")'(66 . 1)(cons 67 PSFLAG))));;分解所有带属性块
)
(PBOBURST)
(command ".-PURGE" "A" "" "N")
;;;;;;;;;;;;;;
(defun pbossget ()
(Setq SS1 (SsGet "X" (list (cons 0 "INSERT")'(2 . "`*U*")(cons 67 PSFLAG))));;分解所有无名块(在CAD2004里执行，动态块转为CAD2004后自动会变成匿名块)
)
(PBOBURST)
;;;;;;;;;;;;;;
(princ "{属性块分解完毕}准备进入下一步，耐心等待...=====》")
(princ)
;;;第二步:炸开动态块(在CAD2004里略去)
;;;第三步:炸开多重引线(在CAD2004里执行，CAD2008的多重引线转成CAD2004后自动变成ACAD_PROXY_ENTITY)
(setvar "qaflags" 1)
(if (/= (SsGet "X" '((0 . "ACAD_PROXY_ENTITY"))) nil)
(command "._explode" (SsGet "X" '((0 . "ACAD_PROXY_ENTITY"))) "")
(princ "选择集为空")
)
(setvar "qaflags" 0)
(command ".-PURGE" "A" "" "N")
(princ "{多重引线分解完毕，耐心等待...}=====》")
(princ)
(command ".-PURGE" "A" "" "N")
(princ "{垃圾清理完毕!}")
(princ)
现在问题是：它只能对当前空间执行，比如当前是在模型空间就只处理模型空间的，不能处理图纸空间的。
根据龙龙仔的指点（感谢龙龙仔！），将程序转成VLISP写就可以实现跨空间处理，并且给出了其中一段炸图的例子，我试过了确实可以！可是除了炸图块外还要固定块的属性、颜色.....等等
龙龙仔帮忙写的部份在这里http://bbs.mjtd.com/forum.php?mod=viewthread&tid=69405
有測試的原始圖+完成圖嗎? <p>龙龙仔，由于论坛对上传文件大小限制，我上传到别的地方了。下面这个网址</p><p></p><p><a href="http://mail.qq.com/cgi-bin/exs_download?uin=78797789&svrid=229&fid=bb10bd2739c7edb2d6f3c370f4e9ad38ce28257961927cda&&txf_fid=b317a68c15e0c82244141e069b6c267917458f0c&&txf_sid=64c025f5e96a8b94d31c2e71d64c84f9f6d495f2&code=22d94b26&k=3e6c1c3083cd917f2c95c07f65644f326e3666338b3037308e3765396b643338372d73767966194b5743">http://mail.qq.com/cgi-bin/exs_download?uin=78797789&svrid=229&fid=bb10bd2739c7edb2d6f3c370f4e9ad38ce28257961927cda&&txf_fid=b317a68c15e0c82244141e069b6c267917458f0c&&txf_sid=64c025f5e96a8b94d31c2e71d64c84f9f6d495f2&code=22d94b26&k=3e6c1c3083cd917f2c95c07f65644f326e3666338b3037308e3765396b643338372d73767966194b5743</a></p><p></p><p></p> 本帖最后由 作者 于 2008-8-15 7:57:07 编辑 <br /><br /> <p>本想在R2008一次完成處理,但因"MULTILEADER"沒有explode方法,所以暫時無法解決,</p><p>(構想是先把其他空間的"MULTILEADER"轉到目前空間,處理完再轉回去)</p><p>巳完成了大部份(但目前沒有時間),把手上的部份先貼上</p><p></p> 本帖最后由 作者 于 2008-8-15 12:56:01 编辑 <br /><br /> <p>版主大人辛苦了！！！</p><p>========================</p><p>刚试用了</p><p>惊喜啊！没想到2008里能分解MULTILEADER！不用转到2004了。如果MULTILEADER也能跨空间处理就完美了。</p><p></p> 本帖最后由 作者 于 2008-8-16 17:46:25 编辑 <br /><br /> <p>龙龙仔，经过反复测试后，发现有个问题。</p><p>有时会提示"Automation 错误"而无法执行下去</p><p>为找出原因，试了上百次都不止，结果就是：</p><p>1、从文件方面：有些文件会但有些不会，出问题与不出问题的文件其实都是很类似的，里面用的块也都是那些，也不是因为某一个图块的问题，没个准。用原来没转成VLISP之前的程序就不会有这问题。</p><p>2、从程序方面，将以下2个地方修改了后就可以执行完，但处理后的结果就不同了....</p><p> (1)、将 (vla-explode (vlax-ename->vla-object BNAME)) 改为 (acet-explode BNAME)</p><p> (2)、将(vla-delete (vlax-ename->vla-object ENAME))这句删除。</p><p>在CAD2004与CAD2008下执行都存在这问题<br/><br/>上传了一个不能正常处理的文件： </p><p></p> 本帖最后由 作者 于 2008-8-18 17:16:24 编辑
用VLISP炸圖塊"!YUQIANG_TK_A2"有問題!!原因不明,待查!! 查出來是圖塊"!YUQIANG_TK_A2",在圖面中的圖塊參考(blockref),與圖塊定義(blockdef)內容不同,即圖塊炸開後物件數量不同,原圖塊定義是"LWPOLYLINE"的物件,炸開後變成了"LINE",造成VLISP在炸開時出錯(但用COMMAND "_.EXPLODE"不會出錯),但是如何造成這現象,待查! <p>被你騙了,原來圖中"!YUQIANG_TK_A2"的blockref是不等比圖塊,vlisp不支持炸開不等比圖塊</p><p>(構想是先把其他空間的"MULTILEADER"轉到目前空間,處理完再轉回去)----巳完成</p><p>但我看出你是要把圖面弄亂,是嗎?</p> <p>啊，哪敢騙龍大人啊，哈哈。。不等比圖塊。。</p><p>這圖塊不是我弄，是個圖框，直接用以前現成的。不是要特地弄成不等比圖塊。回頭將圖塊重做試試.</p><p>MULTILEADER問題解決了？太棒了</p><p>我不是要將圖面弄亂啊。之所以要進行處理是因為：</p><p>1、多重引線：只有2008有，別人用2004打開的話，經常就會看不到這個多重引線的東西，以為是我圖紙沒標材料。分解後就不存在這問題了。</p><p>2、屬性塊、動態塊：因為有屬性，別人打開我的圖後，經常會自己莫名其妙（或不小心）用"X"炸有些圖塊。用"X"炸屬性塊就完蛋了，屬性都回複到最原始的狀態，顯然是不對的。所以要保留屬性分解。</p><p></p>
页:
[1]
2