Greetings all.
First of all, I will appologize if this is in the incorrect forum.
I am from the lisp days, and just got into VBA when I found out they were pulling the plug. While I am trying to learn .NET I have an issue.
Our company is STB based, but we have years of CTB files. In VBA I wrote a convertion where it looked at the colors and based on what I defined for the colors, it assigened the correct line weight and plot style. I wrote this in VBA for AutoCAD 2009, but now in 2011 it tells me "Can't find project or library". I was looking for the solution, and then realized, why solve it in VBA if VBA is going away??
So I am asking to see if anyone would be willing to set me on the correct path, or if anyone has something rsembling this in .NET.
Thanks for any help you can give me.
Bryan Thomasy
Up to AutoCAD 2012 you can enable VBA using AutoCAD_2012_VBAEnabler_Win_32bit.exe
I am sorry, I did not mention that I have the VBA enabler already installed and get that error. Thanks though..
Simple List Layers and PlotStyle sample might help you get started
[CommandMethod("LLPT")] public void ListLayerPlotTable() // This method can have any name { Document dwg = Application.DocumentManager.MdiActiveDocument; Database db = dwg.Database; Editor ed = dwg.Editor; using (Transaction tr = db.TransactionManager.StartTransaction()) { LayerTable layers = (LayerTable)db.LayerTableId.GetObject(OpenMode.ForWrite); foreach (ObjectId lyID in layers) { LayerTableRecord ly = (LayerTableRecord)tr.GetObject(lyID, OpenMode.ForRead); ed.WriteMessage("\n layer: {0}, PlotStyle: {1}", ly.Name, ly.PlotStyleName); } tr.Commit(); } }
That is a great start, thanks. It is painfully obvious I have a lot to learn
Can you show me VBA code?
Maybe I could be able to convert it on VB.NET
~'J'~
I have attached it in a zip format, along with the lisp that calls to it.
Was able to find the short term solution. I still will be trying to convert this to .NET...
OK I will try to do it
...w8
~'J'~
Here is just quickly translated sample
Not sure about if this work good enough
but it will be get you started
and also I can't test this cone on me end because
I'm not using STB and haven't have one on my
home machine
________________________________________________
{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
Using doclock As DocumentLock = doc.LockDocument
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim ltTable As LayerTable = tr.GetObject(db.LayerTableId, OpenMode.ForRead)
Try
For Each ltID As ObjectId In ltTable
Dim ltRec As LayerTableRecord = tr.GetObject(ltID, OpenMode.ForWrite)
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", "bugs").ToString
ed.WriteMessage(vbLf + result)
End Try
End Using
End Using
End Sub
{code}
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'~
Let me know if you need some other stuffs
on this way
Oleg
~'J'~
Can't find what you're looking for? Ask the community or share your knowledge.