I'm not familiar with linetype or lineweight objects but I guess your main issue is that such things as "acLnWtByLwDefault" are autocad enumeration, i.e. they are actually "Long" type constants that you can directly use in your code but not set them via strings
in order to do that you have to build some functions to check the string value against enumeration strings like follows
Function GetLinweight(lineweigthStrng As String, lineweigthEnum As Long) As Boolean
GetLinweight = True
Select Case lineweigthStrng
Case "acLnWtByLayer"
lineweigthEnum = acLnWtByLayer
Case "acLnWtByBlock"
lineweigthEnum = acLnWtByBlock
Case "acLnWtByLwDefault"
lineweigthEnum = acLnWtByLwDefault
Case "acLnWt000"
lineweigthEnum = acLnWt000
' go on listing your other cases
Case Else
GetLinweight = False ' if no match then return False
End Select
End Function
and use it in the fashion of the following
Dim lineweightEnum As Long
If GetLinweight(Cells(x, 8), lineweightEnum) Then layerObj.LineWeight = lineweightEnum 'set current layer line weight only if cell content matches any acad line weight enumeration
this should apply to color property too
while you my want to follow some pieces of advice:
- use the "function" coding pattern to break your code into bits that do specific jobs and have (hopefully) more manageable code
- use "On Error Resume Next" only to prevent error stopping your code in strict conjunction with subsequent code to handle them consciously
- use "Option Explicit" keyword at the very top of your module to force you to declare all variabls to both help you debug your code and have much
- always use full workbook and worksheet range qualification to ensure what excel object you are really acting on
- use "Specialcells" excel range property to loop through specific cells only (e.g.: "only "text" cells, like in this case)
like follows
Option Explicit
Sub C3D()
Dim ACAD As AcadApplication
Dim doc As AcadDocument
If Not GetDoc(ACAD, doc) Then
MsgBox "Autocad session or activedocument not available" & vbCrLf & vbCrLf & "the program ends"
Exit Sub
End If
Dim cell As Range
Dim layerObj As AcadLayer
Dim linetypeName As String
Dim layerData As Variant
Dim colorEnum As Long, lineweightEnum As Long
With Workbooks("MyWorkbookName").Worksheets("myWorksheetName") ' change "MyWorkbookName" or "myWorksheetName" to your actual workbook and worksheet names
For Each cell In .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) ' loop through column "B" not empty cells with text content only
layerData = Application.Transpose(Application.Transpose(cell.Resize(1, 12).Value))
With doc.Layers.Add(layerData(1))
.LayerOn = layerData(2)
.Freeze = layerData(3)
.Lock = layerData(4)
If GetColor(CStr(layerData(5)), colorEnum) Then .Color = colorEnum 'set current layer color only if cell content matches any acad color enumeration
If HasLineTypeBeenLoaded(doc, CStr(layerData(6))) Then .LineType = layerData(6) 'set current layer line type only if cell content matches any acad.lin existing line type
If GetLinweight(CStr(layerData(7)), lineweightEnum) Then .LineWeight = lineweightEnum 'set current layer line weight only if cell content matches any acad line weight enumeration
.PlotStyleName = layerData(9)
.Plottable = layerData(10)
.ViewportDefault = layerData(11)
.Description = layerData(12)
End With
Next
End With
Set doc = Nothing
Set ACAD = Nothing
End Sub
Function GetColor(colorStrng As String, colorEnum As Long) As Boolean
GetColor = True
Select Case UCase(colorStrng)
Case "WHITE"
colorEnum = acWhite
Case "BLUE"
colorEnum = acBlue
Case "RED"
colorEnum = acRed
Case "GREEN"
colorEnum = acGreen
' go on listing your other cases
Case Else
GetColor = False ' if no match then return False
End Select
End Function
Function GetLinweight(lineweigthStrng As String, lineweigthEnum As Long) As Boolean
GetLinweight = True
Select Case lineweigthStrng
Case "acLnWtByLayer"
lineweigthEnum = acLnWtByLayer
Case "acLnWtByBlock"
lineweigthEnum = acLnWtByBlock
Case "acLnWtByLwDefault"
lineweigthEnum = acLnWtByLwDefault
Case "acLnWt000"
lineweigthEnum = acLnWt000
' go on listing your other cases
Case Else
GetLinweight = False ' if no match then return False
End Select
End Function
Function HasLineTypeBeenLoaded(doc As AcadDocument, linetypeName As String)
Dim myLineType As AcadLineType
Err.Clear
On Error Resume Next ' trap any load errors
Set myLineType = doc.Linetypes.Item(linetypeName) ' check for linetype already in document linetypes collection
Err.Clear
If myLineType Is Nothing Then doc.Linetypes.Load linetypeName, "acad.lin" 'if not already there then try adding it
HasLineTypeBeenLoaded = Err = 0
End Function
Function GetDoc(ACAD As AcadApplication, doc As AcadDocument) As Boolean
Set ACAD = Nothing
On Error Resume Next
Set ACAD = GetObject(, "AutoCAD.Application")
If Not ACAD Is Nothing Then
Set doc = ACAD.ActiveDocument
If Not doc Is Nothing Then
ACAD.Visible = True
GetDoc = True
Else
Set ACAD = Nothing
End If
End If
End Function
