原创VLISP中创建文字样式和图层源程序

tcsl9621 发表于 2006-11-8 08:45:00

本帖最后由作者于 2006-11-12 22:06:38 编辑 (vl-load-com)
(setq p2c::acadobj (vlax-get-acad-object)       p2c::acaddocobj (vla-get-activedocument p2c::acadobj)       p2c::mspaceobj (vla-get-modelspace p2c::acaddocobj)       p2c::pspaceobj (vla-get-paperspace p2c::acaddocobj)       p2c::docobj (vla-get-documents p2c::acadobj)       p2c::blocksobj (vla-get-blocks p2c::acaddocobj)       p2c::layersobj (vla-get-layers p2c::acaddocobj)       p2c::textstyles (vla-get-Textstyles p2c::acaddocobj)       p2c::linetypes (vla-get-linetypes p2c::acaddocobj)       p2c::menugroupsel (vla-get-menugroups p2c::acadobj)       p2c::menugroup (vla-item p2c::menugroupsel 0)       p2c::menuobj (vla-get-menus p2c::menugroup)       p2c::toolbars (vla-get-toolbars p2c::menugroup) )
;;;============ ;;;= 设置图层 = ;;;============
.(defun addtranslayer (/      styleobj1   layerobj1         layerobj2     layerobj3   layerobj4         layerobj5     layerobj6   layerobj7         layerobj8     layerobj9   layerobj10        )   (vl-catch-all-apply     'vla-load     (list p2c::linetypes    "center"    "acadiso.lin"     )   )   (vl-catch-all-apply     'vla-load     (list p2c::linetypes    "DASHED"    "acadiso.lin"     )   )   (setq styleobj1 (vla-add p2c::textstyles "GB"))   (vla-put-fontfile styleobj1 "gbenor.shx")   (vla-put-bigfontfile styleobj1 "gbcbig.shx")   (setq layerobj1  (vla-add p2c::layersobj "KERFLEFT")  layerobj2  (vla-add p2c::layersobj "KERFRIGHT")  layerobj3  (vla-add p2c::layersobj "KERFOFF")  layerobj4  (vla-add p2c::layersobj "MARKING")  layerobj5  (vla-add p2c::layersobj "PLATE")  layerobj6  (vla-add p2c::layersobj "ZSQ")  layerobj7  (vla-add p2c::layersobj "CENTER")  layerobj8  (vla-add p2c::layersobj "DASHED") ;;;  layerobj9  (vla-add p2c::layersobj "INSIDE")  layerobj10 (vla-add p2c::layersobj "OUTSIDE")   ) ;;;KERFLEFT   (vla-put-color layerobj1 acred)   (vla-put-lineweight layerobj1 aclnwt025)   (vla-put-linetype layerobj1 "continuous") ;;;KERFRIGHT   (vla-put-color layerobj2 acred)   (vla-put-lineweight layerobj2 aclnwt025)   (vla-put-linetype layerobj2 "continuous") ;;;KERFNO   (vla-put-color layerobj3 acred)   (vla-put-lineweight layerobj2 aclnwt025)   (vla-put-linetype layerobj3 "continuous") ;;;MARKING   (vla-put-color layerobj4 accyan)   (vla-put-lineweight layerobj4 aclnwt025)   (vla-put-linetype layerobj4 "continuous") ;;;PLATE   (vla-put-color layerobj5 acblue)   (vla-put-lineweight layerobj2 aclnwt030)   (vla-put-linetype layerobj5 "continuous") ;;;ZSQ   (vla-put-color layerobj6 acwhite)   (vla-put-linetype layerobj6 "continuous") ;;;CENTER   (vla-put-color layerobj7 acred)   (vla-put-linetype layerobj7 "CENTER") ;;;DASHED   (vla-put-color layerobj8 acgreen)   (vla-put-linetype layerobj8 "DASHED") ;;;INSIDE   (vla-put-color layerobj9 acgreen)   (vla-put-lineweight layerobj9 aclnwt025)   (vla-put-linetype layerobj9 "continuous") ;;;OUTSIDE   (vla-put-color layerobj10 acred)   (vla-put-lineweight layerobj10 aclnwt025)   (vla-put-linetype layerobj10 "continuous") ;;;END   (princ) )
红色为后加代码。不加程序没法运行。

tcsl9621 发表于 2006-11-11 08:57:00

顶回来，再错过。可就没有了。我也不再顶了。再无人问迳就删除源代码。呵……

lxwlxwaayf 发表于 2006-11-11 20:05:00

看看

rongyifei 发表于 2006-11-11 20:15:00

有这么的热心的大哥,真的太幸运了!

rongyifei 发表于 2006-11-12 16:28:00

不过运行不了!
出现下面的提示:
error: bad argument type: VLA-OBJECT nil
我看不明白:
程序中的p2c::textstyles,p2c::linetypes,p2c::layersobj等都没有定义,
程序能正常运行吗?还望指点!!!

tcsl9621 发表于 2006-11-12 20:04:00

程序前加这些:
(vl-load-com)
(setq p2c::acadobj (vlax-get-acad-object)       p2c::acaddocobj (vla-get-activedocument p2c::acadobj)       p2c::mspaceobj (vla-get-modelspace p2c::acaddocobj)       p2c::pspaceobj (vla-get-paperspace p2c::acaddocobj)       p2c::docobj (vla-get-documents p2c::acadobj)       p2c::blocksobj (vla-get-blocks p2c::acaddocobj)       p2c::layersobj (vla-get-layers p2c::acaddocobj)       p2c::textstyles (vla-get-Textstyles p2c::acaddocobj)       p2c::linetypes (vla-get-linetypes p2c::acaddocobj)       p2c::menugroupsel (vla-get-menugroups p2c::acadobj)       p2c::menugroup (vla-item p2c::menugroupsel 0)       p2c::menuobj (vla-get-menus p2c::menugroup)       p2c::toolbars (vla-get-toolbars p2c::menugroup) )
就好了.

rongyifei 发表于 2006-11-12 20:14:00

多谢!

tcsl9621 发表于 2006-11-12 22:09:00

这是我编的程序中的一部分。现在这已是我所有程序都用的成熟代码。

qianglcq 发表于 2006-12-10 15:53:00

多谢版主分享

li_abcxyz 发表于 2006-12-14 19:44:00

谢谢，获益匪浅呢

页: [1] 2 3

明经CAD社区's Archiver

原创VLISP中创建文字样式和图层源程序