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

userzhl

(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))
)
))

userzhl

这是一个建立图层及线型的函数,哪个高手帮帮忙,改一下?

Andyhon

(if (/= nil (tblsearch "layer" layname))
    (progn
      ....
    )
    (progn
      ....
    )
    (progn
      ....
    )
    (progn
      ....
    )
)

您得先厘订这个语法错误....

userzhl

改了一下,还是不行呢?

(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))
)
)
)

xshrimp

3. ;(mla   "test"  25  "ACAD_ISO02W100")
4. (defun MLA  (layname laycolor LayLine)
5. (setq acadobject1   (vlax-get-acad-object)
6.        acaddocument1 (vla-get-activedocument acadobject1)
7.        mspace1         (vla-get-modelspace acaddocument1))
8. (setq LayerSel (vla-get-Layers AcadDocument1))
9. (setq LayerObj (vla-add LayerSel layname))
10. (setq LineObj (vla-get-Linetypes AcadDocument1))
11. (if (/= nil (tblsearch "layer" layname))
12.   (progn
13.      (if (/= nil laycolor)
14.       (vla-put-color LayerObj laycolor)))
15.   (progn
16.      (vla-get-activelayer AcadDocument1 LayerObj)
17.      (if (/= nil laycolor)
18. (vla-put-color LayerObj laycolor))
19. )
20. )
21. (if (/= nil LayLine)
22. (progn
23. (if (not (tblsearch "LTYPE" LayLine))
24. (command "-linetype" "l" LayLine "acad.lin" "")
25. )
26. (vl-catch-all-apply 'vla-put-Linetype (list LayerObj LayLine))
27. )
28. (vla-put-Linetype LayerObj (vla-get-name (vla-get-ActiveLinetype AcadDocument1 )))
29. )
30. )

;(mla   "test"  25  "ACAD_ISO02W100") (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) (progn (if (not (tblsearch "LTYPE" LayLine)) (command "-linetype" "l" LayLine "acad.lin" "") ) (vl-catch-all-apply 'vla-put-Linetype (list LayerObj LayLine)) ) (vla-put-Linetype LayerObj (vla-get-name (vla-get-ActiveLinetype AcadDocument1 ))) ) )

userzhl

谢谢xshrimp