trebao bi prvo definisati osobine layera, zatim pozivati tipove linija, a one se nalaze u fajlu acad.lin
evo malo sam kopao po svojoj arhivi i mislim da ti baš ovako nešto treba
Code:
Sub SetLayerAndLineType()
LoadLineType
GenLayers "Primary"
GenLayers "Dimension", , acGreen, acLnWt000
GenLayers "Label", , acMagenta, acLnWt005
GenLayers "Text", , acBlue, acLnWt005
GenLayers "Center", "Center", acRed, acLnWt005
GenLayers "Hidden", "Hidden", acYellow, acLnWt005
GenLayers "Steel", , acRed, acLnWt009
End Sub
Public Sub LoadLineType()
On Error Resume Next
ThisDrawing.Linetypes.Load "CENTER", "ACAD.LIN"
ThisDrawing.Linetypes.Load "HIDDEN", "ACAD.LIN"
ThisDrawing.Linetypes.Load "PHANTOM", "ACAD.LIN"
Err.Clear
On Error Goto 0
End Sub
Public Sub GenLayers(iLyrNm As String, Optional iLnTyp = _
"Continuous", Optional iClr = acBlue, Optional iLnWght _
= acLnWt015)
Dim mTmpLyer As AcadLayer
Set mTmpLyer = MakeALayer(iLyrNm)
mTmpLyer.Color = iClr
mTmpLyer.Linetype = iLnTyp
mTmpLyer.LayerOn = True
mTmpLyer.Lineweight = iLnWght
Set mTmpLyer = Nothing
End Sub
Function MakeALayer(LayerName As String) As AcadLayer
Dim mLyrNm As AcadLayer
On Error Resume Next
Set mLyrNm = ThisDrawing.Layers.Add(LayerName)
If Err.Number <> 0 Then
Set mLyrNm = ThisDrawing.Layers(LayerName)
End If
Err.Clear
On Error Goto 0
Set MakeALayer = mLyrNm
Set mLyrNm = Nothing
End Function