如何用ActiveX创建一个图层？

cag

我想用ActiveX方法创建一个图层，却发现并没有vla-addlayer函数？是真的吗？怎么办？

meflying

;以下是加载删除线型，添加删除图层，并设定其颜色，

(vl-load-com)
(defun listline(/ adoc ltps n i ltp1)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq ltps (vla-get-linetypes adoc))
  (setq n (vla-get-count ltps))
  (setq i 3)
  (repeat (- n 3)
    (setq ltp1 (vla-item ltps i))
    (princ "\n")
    (print (vla-get-name ltp1))
    (princ "\n")
    (setq i (1+ i))
  )
  (princ)
)
(defun c:loadline(/ adoc msp ltps lname)
  (setq lname (getstring "输入需要添加的线型:"))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq ltps (vla-get-linetypes adoc))
  (setq ltp (vl-catch-all-apply 'vla-load (list ltps lname "acadiso.lin")))
  (if (vl-catch-all-error-p ltp)
    (princ "此线型已存在！")
    (princ)
  )
  (princ)
)
(defun c:delline(/ adoc msp ltps ltp lname)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq ltps (vla-get-linetypes adoc))
  (setq lname (getstring "输入需要删除的线型<*>:"))
  (if (= lname "") (listline))
  (while (= lname "")
    (setq lname (getstring "输入需要删除的线型[List]:"))
    (if (= (strcase lname 0) "l") (progn (listline) (setq lname "")))
  )
  (setq ltp (vl-catch-all-apply 'vla-item (list ltps lname)))
  (if (vl-catch-all-error-p ltp)
    (princ "没有此线型！")
    (vla-delete ltp)
  )
  (princ)
)

(defun c:dellayer(/ adoc msp ltps ltp lname)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq ltps (vla-get-layers adoc))
  (setq lname (getstring "输入需要删除的图层<*>:"))
  (if (= lname "") (listlayer))
  (while (= lname "")
    (setq lname (getstring "输入需要删除的图层[List]:"))
    (if (= (strcase lname 0) "l") (progn (listlayer) (setq lname "")))
  )
  (setq ltp (vl-catch-all-apply 'vla-item (list ltps lname)))
  (if (vl-catch-all-error-p ltp)
    (princ "没有此图层！")
    (vla-delete ltp)
  )
  (princ)
)

(defun listlayer(/ adoc ltps n i ltp1)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq ltps (vla-get-layers adoc))
  (setq n (vla-get-count ltps))
  (setq i 0)
  (repeat (- n 0)
    (setq ltp1 (vla-item ltps i))
    (princ "\n")
    (print (vla-get-name ltp1))
    (princ "\n")
    (setq i (1+ i))
  )
)

(defun Newlayer(lname lcolor / layer layers adoc)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq layers (vla-get-layers adoc))
  (setq layer (vl-catch-all-apply 'vla-item (list layers lname)))
  (if (vl-catch-all-error-p layer)
    (progn
      (setq layer (vla-add layers lname))
      (vla-put-color layer lcolor)
    )
  )
  (vla-put-ActiveLayer adoc layer)
  (princ)
)