[求助]这个函数怎样修改？

HQ_2003 · 发表于 2003-9-1 18:16:00

这是meflying版主写的一个函数，请问怎样处理在创建图层的同时，并且创建此图层的线型(laylinetype)


(defun AddLayer (LayerName LayerColor / AcadDocument LayerSel LayerObj)
     (setq AcadDocument (vla-get-activedocument (vlax-get-acad-object)))
     (setq LayerSel (vla-get-layers AcadDocument))
     (setq LayerObj (vl-catch-all-apply 'vla-item (list LayerSel Layername)))
     (if (vl-catch-all-error-p LayerObj)
       (progn
         (setq LayerObj (vla-add LayerSel LayerName))
         (vla-put-color LayerObj LayerColor)
       )
     )
     (vla-put-activeLayer AcadDocument LayerObj)
     (princ)
   )
(AddLayer 11 3)

meflying · 发表于 2003-9-1 18:25:00

(vl-put-linetype layerobj laylinetype)
laylinetype必须已经加载

HQ_2003 · 发表于 2003-9-2 14:14:00

其实先前我是用vl-put-linetype函数试验过，可总是出错，可能是“laylinetype“线型没有加载的缘故吧。
谢了！

龙龙仔 · 发表于 2003-9-4 08:05:00

(defun ADDLAYER       (LAYERNAME       LAYERCOLOR    LAYERLINETYPE
               /             ACADDOCUMENT LAYERSEL
               LAYEROBJ
            )
  (setq ACADDOCUMENT (vla-get-activedocument (vlax-get-acad-object)))
  (setq LTYPE (vla-get-linetypes ACADDOCUMENT))
  (if (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-item (list LTYPE LAYERLINETYPE))
   )
(vla-load LTYPE
            LAYERLINETYPE
            "acad.lin"
)
  )
  (setq LAYERSEL (vla-get-layers ACADDOCUMENT))
  (if (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-item (list LAYERSEL LAYERNAME))
   )
(progn
   (setq LAYEROBJ (vla-add LAYERSEL LAYERNAME))
   (vla-put-color LAYEROBJ LAYERCOLOR)
   (vla-put-linetype LAYEROBJ LAYERLINETYPE)
)
  )
  (vla-put-activelayer ACADDOCUMENT LAYEROBJ)
  (vlax-release-object ACADDOCUMENT)
  (vlax-release-object LAYERSEL)
  (princ)
)
;;(ADDLAYER 11 3 "hidden2")

HQ_2003 · 发表于 2003-9-5 13:15:00

太好了!高手就是高手。
唉！我太崇拜你了。

[求助]这个函数怎样修改？

发表回复

精选推荐