如何用ActiveX创建一个图层？

cag · 发表于 2003-6-27 11:07:00

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

meflying · 发表于 2003-6-27 11:19:00

;以下是加载删除线型，添加删除图层，并设定其颜色，
(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)
)

如何用ActiveX创建一个图层？

发表回复

精选推荐