I added possibility to check if the plotstyle is exist in your document
{code}
<CommandMethod("IMRColors", CommandFlags.Modal + CommandFlags.Session)> _
Public Sub STBTest()
If Autodesk.AutoCAD.ApplicationServices.Application.GetSystemVariable("PSTYLEMODE") = 1 Then
MsgBox("Drawing is not STB")
Exit Sub
End If
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim how As Boolean = False
Dim pltStyles As List(Of String) = New List(Of String)({"Black", "DGray", "MGray", "LGray", "White", "Normal"})
Using doclock As DocumentLock = doc.LockDocument
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim ltTable As LayerTable = tr.GetObject(db.LayerTableId, OpenMode.ForRead)
Try
Dim pstDict As DictionaryWithDefaultDictionary = tr.GetObject(db.PlotStyleNameDictionaryId, DatabaseServices.OpenMode.ForRead)
For n As Integer = 0 To pltStyles.Count - 1
Dim pltSt As String = pltStyles(n)
If Not pstDict.Contains(pltSt) = True Then
MsgBox("PlotStyle """ + pltSt + """ does not exist. Program Exiting")
Return
End If
Next
For Each ltID As ObjectId In ltTable
Dim ltRec As LayerTableRecord = tr.GetObject(ltID, OpenMode.ForWrite)
If ltRec.IsLocked Then
MsgBox(ltRec.Name + " is locked. it will be unlocked")
ltRec.IsLocked = False
End If
Dim i As Double
i = 0
Dim y As Integer
y = 0
Dim sPlotStyleName As String
sPlotStyleName = ltRec.PlotStyleName
Dim cLayerColor As Color
cLayerColor = ltRec.Color
Dim sLayerColor As Short
sLayerColor = cLayerColor.ColorIndex
Dim cLineweight As LineWeight
cLineweight = ltRec.LineWeight
Select Case sLayerColor
Case 1, 15 To 30, 230 To 239
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight009
Case 2, 31 To 59
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight050
Case 3, 60 To 129
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight018
Case 7, 240 To 249
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight025
Case 6, 180 To 229
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight030
Case 4, 5, 130 To 179
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight040
Case 10
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight050
Case 11
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight070
Case 12
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight080
Case 13
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight090
Case 14
ltRec.PlotStyleName = "Black"
ltRec.LineWeight = LineWeight.LineWeight120
Case 8
ltRec.PlotStyleName = "LGray"
ltRec.LineWeight = LineWeight.LineWeight009
Case 9
ltRec.PlotStyleName = "LGray"
ltRec.LineWeight = LineWeight.LineWeight015
Case 251
ltRec.PlotStyleName = "LGray"
ltRec.LineWeight = LineWeight.LineWeight020
Case 252
ltRec.PlotStyleName = "MGray"
ltRec.LineWeight = LineWeight.LineWeight030
Case 253
ltRec.PlotStyleName = "MGray"
ltRec.LineWeight = LineWeight.LineWeight050
Case 255
ltRec.PlotStyleName = "MGray"
ltRec.LineWeight = LineWeight.LineWeight140
Case 254, 250
ltRec.PlotStyleName = "White"
ltRec.LineWeight = LineWeight.LineWeight009
Case Else
ed.WriteMessage(ltRec.Name & " was not altered" & vbCrLf)
i = i + 1
End Select
Next
tr.Commit()
how = True
Catch ex As Autodesk.AutoCAD.Runtime.Exception
Dim y As Integer = 0
If ex.Message Like "Key Not Found*" And y < 30000 Then
Dim oPoint As DBPoint = Nothing
Dim dLoc As Double() = New Double(2) {}
dLoc(0) = 5.0
dLoc(1) = 5.0
dLoc(2) = 0.0
Dim crnSP As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
crnSP.AppendEntity(oPoint)
tr.AddNewlyCreatedDBObject(oPoint, True)
oPoint.PlotStyleName = "Black"
oPoint.PlotStyleName = "DGray"
oPoint.PlotStyleName = "MGray"
oPoint.PlotStyleName = "LGray"
oPoint.PlotStyleName = "White"
oPoint.PlotStyleName = "Normal"
oPoint.Erase()
y = y + 1
Else
MsgBox("Something went wrong " + Err.Description & ", that sounds awful")
Return
End If
ed.WriteMessage(ex.Message)
how = False
Finally
Dim result As String = " --- The IMRColors program has ended up with " + IIf(how, "success", "some bugs").ToString
ed.WriteMessage(vbLf + result)
End Try
End Using
End Using
End Sub
{code}
~'J'~
_____________________________________
C6309D9E0751D165D0934D0621DFF27919
