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

HQ_2003

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

2. (defun AddLayer (LayerName LayerColor / AcadDocument LayerSel LayerObj)
   
3.      (setq AcadDocument (vla-get-activedocument (vlax-get-acad-object)))
   
4.      (setq LayerSel (vla-get-layers AcadDocument))
   
5.      (setq LayerObj (vl-catch-all-apply 'vla-item (list LayerSel Layername)))
   
6.      (if (vl-catch-all-error-p LayerObj)
   
7.        (progn
   
8.          (setq LayerObj (vla-add LayerSel LayerName))
   
9.          (vla-put-color LayerObj LayerColor)
   
10.        )
    
11.      )
    
12.      (vla-put-activeLayer AcadDocument LayerObj)
    
13.      (princ)
    
14.    )
    
15. (AddLayer 11 3)

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

meflying

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

HQ_2003

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

龙龙仔

(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

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