【转帖】[求助]请教高手,帮我看看这段程序,为何出错呢?(已解决)
 

[求助]请教高手,帮我看看这段程序,为何出错呢?(已解决)
www.dimcax.com
[求助]请教高手,帮我看看这段程序,为何出错呢?(已解决)(defun mla (layname laycolor layline)
(setq acadobject1 (vlax-get-acad-object)
acaddocument1 (vla-get-activedocument acadobject1)
mspace1 (vla-get-modelspace acaddocument1))
(setq layersel (vla-get-layers acaddocument1))
(setq layerobj (vla-add layersel layname))
(setq lineobj (vla-get-linetypes acaddocument1))
(if (/= nil (tblsearch "layer" layname))
(progn
(if (/= nil laycolor)
(vla-put-color layerobj laycolor)))
(progn
(vla-get-activelayer acaddocument1 layerobj)
(if (/= nil laycolor)
(vla-put-color layerobj laycolor))
)
(progn
(if (/= nil layline)
(vla-put-linetype lineobj layline)))
(progn
(vla-get-activelinetype acaddocument1 layerobj)
(if (/= nil layline)
(vla-put-linetype lineobj layline))
)
))
d
这是一个建立图层及线型的函数,哪个高手帮帮忙,改一下?
d
(if (/= nil (tblsearch "layer" layname))
(progn
....
)
(progn
....
)
(progn
....
)
(progn
....
)
)
您得先厘订这个语法错误....
d
改了一下,还是不行呢?
(defun mla (layname laycolor layline)
(setq acadobject1 (vlax-get-acad-object)
acaddocument1 (vla-get-activedocument acadobject1)
mspace1 (vla-get-modelspace acaddocument1))
(setq layersel (vla-get-layers acaddocument1))
(setq layerobj (vla-add layersel layname))
(setq lineobj (vla-get-linetypes acaddocument1))
(if (/= nil (tblsearch "layer" layname))
(progn
(if (/= nil laycolor)
(vla-put-color layerobj laycolor)))
(progn
(vla-get-activelayer acaddocument1 layerobj)
(if (/= nil laycolor)
(vla-put-color layerobj laycolor))
)
)
(if (/= nil layline)
(vla-put-linetype layerobj layline)
(progn
(vla-get-activelinetype acaddocument1 layerobj)
(if (/= nil layline)
(vla-put-linetype layerobj layline))
)
)
)
d
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
;(mla "test" 25 "acad_iso02w100")
( mla (layname laycolor layline)
( acadobject1 ()
acaddocument1 (vla-get-activedocument acadobject1)
mspace1 (vla-get-modelspace acaddocument1))
( layersel (vla-get-layers acaddocument1))
( layerobj (vla-add layersel layname))
( lineobj (vla-get-linetypes acaddocument1))
( ( nil ( "layer" layname))
(
( ( nil laycolor)
(vla-put-color layerobj laycolor)))
(
(vla-get-activelayer acaddocument1 layerobj)
( ( nil laycolor)
(vla-put-color layerobj laycolor))
)
)
( ( nil layline)
(
( ( ( "ltype" layline))
( "-linetype" "l" layline "acad.lin" "")
)
( 'vla-put-linetype ( layerobj layline))
)
(vla-put-linetype layerobj (vla-get-name (vla-get-activelinetype acaddocument1 )))
)
)
d
谢谢xshrimp