activex - make layer

My snippet is from a lisp that uses the layer that the polyline is made on.
What I would like is to make and set a given layer, color and linetype,
using activex.

many thanks
Russ

(if (setq CurEnt (MeSelPline "\nSelect a closed Polyline <exit>: " T T))
(progn
(setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
CurSpc (MeGetCurSpace AcaDoc)
CurObj (vlax-ename->vla-object (car CurEnt))
ObjLay (vla-get-Layer CurObj) ;<- at the moment it takes this
layer
TmpLst (vlax-get CurObj 'Coordinates)
)

(vla-StartUndoMark AcaDoc)
(cond
((= (length RetLst) 4) ;4-side

(MeDrawLine (nth 0 RetLst) (nth 2 RetLst) ObjLay CurSpc)
(setq Pt1 (nth 0 RetLst))
(setq Pt2 (nth 2 RetLst))
(MeDrawLine (nth 1 RetLst) (nth 3 RetLst) ObjLay CurSpc)
(setq Pt3 (nth 1 RetLst))
(setq Pt4 (nth 3 RetLst))
)

)

(defun MeDrawLine (Fpt Npt Lay Spc / TmpObj TxtPt1 )

(setq TmpObj (vla-AddLine Spc(vlax-3d-point Fpt)(vlax-3d-point Npt))

);setq

(if Lay (vla-put-Layer TmpObj Lay))
);defun

 

Hi Russell

Chjeck this out:

Code:

;
; == Function MeMakeLayer
; Creates a Layer with appropriate parameters.
; Arguments [Type]:
;   Nme = Layer name [STR]
;   Col = Color number [INT]
;         False if not used
;   Ltp = Ltype [STR]
;         False if not used
; Return [Type]:
;   > True if succeed or layer exist, else False
; Notes:
;   - If a linetype was not found, MeMakeLayer displays an error
;     message.
;
(defun MeMakeLayer (Nme Col Ltp / AcaDoc LayCol LayObj RetVal)
(setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
LayCol (vla-get-Layers AcaDoc)
RetVal T
)
(if (vl-catch-all-error-p
(vl-catch-all-apply 'vla-Item (list LayCol Nme))
)
(if (or (not Ltp) (MeEnsureLtypeAvailable Ltp AcaDoc))
(progn
(setq LayObj (vla-add LayCol Nme))
(if Col (vla-put-Color LayObj Col))
(if Ltp (vla-put-Linetype LayObj Ltp))
)
(setq RetVal nil)
)
)
RetVal
)
;
; == Function MeEnsureLtypeAvailable
; Ensures that the linetype is available.
; Arguments [Type]:
;   Nme = Linetype name [STR]
;   Doc = Acad document object [VLA-OBJECT]
; Returns [Type]:
;   > True if available, else False
; Notes:
;   None
;
(defun MeEnsureLtypeAvailable (Nme Doc / LtpLst RetVal)
(setq RetVal T
LtpLst (mapcar 'strcase (mapcar 'car (MeGetLineTypes Doc)))
)
(if (not (vl-position (strcase Nme) LtpLst))
(if (vl-catch-all-error-p
(vl-catch-all-apply
'vla-load (list (vla-get-Linetypes Doc) Nme "acad.lin")
)
)
(setq RetVal (alert (strcat "Linetype '" Nme "' not found.")))
)
)
RetVal
)
;
; == Function MeGetLineTypes
; Returns a list of all line types and her descriptons.
; Arguments [Type]:
;   Doc = Acad document object [VLA-OBJECT]
; Return [Type]:
;   > Dotted pair list '(("LtpName" . "Description")...) [LIST]
; Notes:
;   None
;
(defun MeGetLineTypes (Doc / LtpLst)
(vlax-for Ltp (vla-get-LineTypes Doc)
(setq LtpLst (cons
(cons
(vla-get-Name Ltp)
(vla-get-Description Ltp)
)
LtpLst
)
)
(vlax-release-object Ltp)
)
(reverse LtpLst)
)

Cheers

 

many thanks Jürg for your time again
cheers Russ

 

Hi Russell

Welcome...¦-)

Cheers