一次性建立多个层，自定义函数通不过，大家帮忙解决一下

zhongys

一次性建立多个层，自定义函数通不过，大家帮忙解决一下,不知哪里出错.

(DEFUN new_lay (lay coL lt / chk_lay)
  (setq chk_lay (tblsearch "layer" lay))
  (if (= chk_lay nil)
    (command "layer" "new" lay "c" coL lay "lt" lt lay "")
  )
)

(DEFUN c:ma_lay(/hat cen hid das mcl dim run cut_line bom core_water plate_water slide_water txt ejp ejt)
(setvar "cmdecho" 0)
      (setq hat         "剖面线层")
      (setq cen         "中心线层")
      (setq hid         "短虚线层")
      (setq das         "长虚线层")
      (setq mcl         "细实线层")
      (setq dim         "尺寸线层")
      (setq run         "流道层")
      (setq cut_line    "线切割层")
      (setq bom         "气泡球层")
      (setq pha         "假想线层")
      (setq core_water  "模仁水路层")
      (setq plate_water "模板水路层")
      (setq slide_water "滑块水路层")
      (setq txt         "文字层")
      (setq ejp         "顶出板层")
      (setq ejT         "顶针平面层")

      (new_lay hat   40           "CONTINUOUS")
      (new_lay cen   1            "CENTER")
      (new_lay hid   3            "HIDDEN")
      (new_lay das   6            "DASHED")
      (new_lay MCL   2            "CONTINUOUS")
      (new_lay dim   4            "Continuous")
      (new_lay RUN   2            "CONTINUOUS")
      (new_lay CUT_LINE  2            "CONTINUOUS")
      (new_lay BOM   241          "phantom")
      (new_lay PHA   8            "phantom")
      (new_lay core_water  171          "DASHED")
      (new_lay plate_water  141          "DASHED")
      (new_lay slide_water  31           "DASHED")
      (new_lay TXT   6            "CONTINUOUS")
      (new_lay EJP   132          "HIDDEN")
      (new_lay EJT   7            "CONTINUOUS")
(PROMPT "\n 新图层已建立")
(princ)
)

monsterWu

感謝無私提供分享

cauin

(/hat....

--->

(/ hat

少个空格

AMTONNY

呵呵,不用这么麻烦,来个简单的,一个命令完成,请自已更改图层名

xyp1964

2. ;;一次性建立多个层
3. (DEFUN c:tt (/ lt lst)
4.   (DEFUN mklacolt (lay col lt / chk_lay)
5.     (if (= (tblsearch "layer" lay) nil)
6.       (command "layer" "new" lay "c" col lay "lt" lt lay "")
7.     )
8.   )
9.   (setvar "cmdecho" 0)
10.   (foreach lt '("CENTER" "HIDDEN" "DASHED" "phantom")
11.     (if (= (tblsearch "ltype" lt) nil)
12.       (command "_linetype" "l" lt "" "")
13.     )
14.   )
15.   (foreach lst '(("剖面线层" 40 "CONTINUOUS")
16.    ("中心线层" 1 "CENTER")
17.    ("短虚线层" 3 "HIDDEN")
18.    ("长虚线层" 6 "DASHED")
19.    ("细实线层" 2 "CONTINUOUS")
20.    ("尺寸线层" 4 "Continuous")
21.    ("流道层" 2 "CONTINUOUS")
22.    ("线切割层" 2 "CONTINUOUS")
23.    ("气泡球层" 241 "phantom")
24.    ("假想线层" 8 "phantom")
25.    ("模仁水路层" 171 "DASHED")
26.    ("模板水路层" 141 "DASHED")
27.    ("滑块水路层" 31 "DASHED")
28.    ("文字层" 6 "CONTINUOUS")
29.    ("顶出板层" 132 "HIDDEN")
30.    ("顶针平面层" 7 "CONTINUOUS")
31.   )
32.     (mklacolt (car lst) (cadr lst) (caddr lst))
33.   )
34.   (PROMPT "\n新图层已建立")
35.   (princ)
36. )

;;一次性建立多个层 (DEFUN c:tt (/ lt lst)   (DEFUN mklacolt (lay col lt / chk_lay)     (if (= (tblsearch "layer" lay) nil)       (command "layer" "new" lay "c" col lay "lt" lt lay "")     )   )   (setvar "cmdecho" 0)   (foreach lt '("CENTER" "HIDDEN" "DASHED" "phantom")     (if (= (tblsearch "ltype" lt) nil)       (command "_linetype" "l" lt "" "")     )   )   (foreach lst '(("剖面线层" 40 "CONTINUOUS")    ("中心线层" 1 "CENTER")    ("短虚线层" 3 "HIDDEN")    ("长虚线层" 6 "DASHED")    ("细实线层" 2 "CONTINUOUS")    ("尺寸线层" 4 "Continuous")    ("流道层" 2 "CONTINUOUS")    ("线切割层" 2 "CONTINUOUS")    ("气泡球层" 241 "phantom")    ("假想线层" 8 "phantom")    ("模仁水路层" 171 "DASHED")    ("模板水路层" 141 "DASHED")    ("滑块水路层" 31 "DASHED")    ("文字层" 6 "CONTINUOUS")    ("顶出板层" 132 "HIDDEN")    ("顶针平面层" 7 "CONTINUOUS")   )     (mklacolt (car lst) (cadr lst) (caddr lst))   )   (PROMPT "\n新图层已建立")   (princ) )

zhongys

谢谢

zhongys

我开始也是用COMMAND作的图层。但现在是想用自定义函数，引用到其它程式中，由于是半路出家，有些基本东西没有搞清，

谢谢各位!

5061220

俺也用的是最古老的方法，自定义函数也是一知半解。学习了

fl202

4楼的程序很简洁，对表的运用不错，学习下！

nonsmall

龙龙仔

3. ;|
4. (NEW_LAYER '(("剖麵線層" 40 "CONTINUOUS")
5.       ("中心線層" 1 "CENTER")
6.       ("短虛線層" 3 "HIDDEN")
7.       ("長虛線層" 6 "DASHED")
8.       ("細實線層" 2 "CONTINUOUS")
9.       ("尺寸線層" 4 "Continuous")
10.       ("流道層" 2 "CONTINUOUS")
11.       ("線切割層" 2 "CONTINUOUS")
12.       ("氣泡球層" 241 "phantom")
13.       ("假想線層" 8 "phantom")
14.       ("模仁水路層" 171 "DASHED")
15.       ("模板水路層" 141 "DASHED")
16.       ("滑塊水路層" 31 "DASHED")
17.       ("文字層" 6 "CONTINUOUS")
18.       ("頂出板層" 132 "HIDDEN")
19.       ("頂針平面層" 7 "CONTINUOUS")
20.      )
21. )
22. |;
23. ;;一次性建立多個層
24. (defun NEW_LAYER (LST / X DOC)
25.   (vl-load-com)
26.   (setq DOC (vla-get-activedocument (vlax-get-acad-object)))
27.   (mapcar
28.     '(lambda (X)
29.        (if (not (tblsearch "ltype" (nth 2 X)))
30.   (vla-load (vla-get-linetypes DOC)
31.      (nth 2 X)
32.      (if (= (vlax-variant-value
33.        (vla-getvariable DOC "measureinit")
34.      )
35.      0
36.          )
37.        "acad.lin"
38.        "acadiso.lin"
39.      )
40.   )
41.        )
42.        (entmake
43.   (list '(0 . "LAYER")
44.         '(100 . "AcDbSymbolTableRecord")
45.         '(100 . "AcDbLayerTableRecord")
46.         (cons 2 (nth 0 X))
47.         '(70 . 0)
48.         (cons 62 (nth 1 X))
49.         (cons 6 (nth 2 X))
50.   )
51.        )
52.      )
53.     LST
54.   )
55.   (vlax-release-object DOC)
56.   (princ)
57. )

;| (NEW_LAYER '(("剖麵線層" 40 "CONTINUOUS")       ("中心線層" 1 "CENTER")       ("短虛線層" 3 "HIDDEN")       ("長虛線層" 6 "DASHED")       ("細實線層" 2 "CONTINUOUS")       ("尺寸線層" 4 "Continuous")       ("流道層" 2 "CONTINUOUS")       ("線切割層" 2 "CONTINUOUS")       ("氣泡球層" 241 "phantom")       ("假想線層" 8 "phantom")       ("模仁水路層" 171 "DASHED")       ("模板水路層" 141 "DASHED")       ("滑塊水路層" 31 "DASHED")       ("文字層" 6 "CONTINUOUS")       ("頂出板層" 132 "HIDDEN")       ("頂針平面層" 7 "CONTINUOUS")      ) ) |; ;;一次性建立多個層 (defun NEW_LAYER (LST / X DOC)   (vl-load-com)   (setq DOC (vla-get-activedocument (vlax-get-acad-object)))   (mapcar     '(lambda (X)        (if (not (tblsearch "ltype" (nth 2 X)))   (vla-load (vla-get-linetypes DOC)      (nth 2 X)      (if (= (vlax-variant-value        (vla-getvariable DOC "measureinit")      )      0          )        "acad.lin"        "acadiso.lin"      )   )        )        (entmake   (list '(0 . "LAYER")         '(100 . "AcDbSymbolTableRecord")         '(100 . "AcDbLayerTableRecord")         (cons 2 (nth 0 X))         '(70 . 0)         (cons 62 (nth 1 X))         (cons 6 (nth 2 X))   )        )      )     LST   )   (vlax-release-object DOC)   (princ) )