I'm almost finished with my VBA routine, but I'm having the hardest time with this. I think I'm over thinking it, so I feel like I need to just ask for help.
This routine is for a user to click a button, and the routine will look at the xref layers and determine the prefixes and ask the user to select one or more prefixes to change all to one color. The option of colors is a true color 192,192,192, or a index color of cyan, black or pink (color 11). I got it to give me the indexes pretty easily (I thought that was going to be the hard part.) but changing the colors to an index color or a true color is tougher.
I got it to change it to a true color no problem, but the option of index colors is the problem.
I've even asked the AI to help me, and it was no help. Here's the code.
Sub ChangePrefixColor(ByVal prefixes As Collection, ByVal colorValue As Variant)
Dim doc As AcadDocument
Set doc = ThisDrawing.Application.ActiveDocument
Dim i As Long
Dim prefix As Variant
Dim color As AcadAcCmColor
' Set color based on radio button selection
If UserForm1.RadioButton1.value Then
' Use color 192,192,192 (true color)
Set color = New AcadAcCmColor
color.SetRGB 192, 192, 192
ElseIf UserForm1.RadioButton2.value Then
' Use color index 11
Set color = ThisDrawing.Application.GetInterfaceObject("AutoCAD.AcCmColor.17")
color.SetColorIndex AcColorMethod.acColorMethodByACI, 11
ElseIf UserForm1.RadioButton3.value Then
' Use color index 0
Set color = ThisDrawing.Application.GetInterfaceObject("AutoCAD.AcCmColor.17")
color.SetColorIndex AcColorMethod.acColorMethodByACI, 0
ElseIf UserForm1.RadioButton4.value Then
' Use color index 2
Set color = ThisDrawing.Application.GetInterfaceObject("AutoCAD.AcCmColor.17")
color.SetColorIndex AcColorMethod.acColorMethodByACI, 2
End If
' Loop through prefixes and change layer color
For Each prefix In prefixes
For i = 0 To doc.layers.Count - 1
Dim layer As AcadLayer
Set layer = doc.layers.item(i)
If InStr(layer.Name, prefix) = 1 Then
If UserForm1.RadioButton1.value Then
layer.TrueColor = color
Else
layer.color = color
End If
End If
Next i
Next prefix
' Regenerate the drawing
doc.Regen acAllViewports
End Sub
Anyone have any ideas?
Thanks
