VBA in ACAD

[ETracker]

Hi everyone,

I have been assigned a project that will require the use of some VBA code to run in ACAD. At first I did not think this was possible, but after some looking around I found this section of the forum that talked about ACAD. For this project, I will need to write some code that will be able to open and change 1 to 3 things on about 75 drawings. The items that will be changing will be in the title block of the drawing. I am using VBA in a lot of my excel files, but have never used it in the ACAD format. If any body could give me a sample file or a location I could go and get some ideas to how this is done in ACAD it would be greatly apprecited. At this time I am thinking that I will need to store the code in a diff. file so it will be able to open and close that amout of files.

Thanks for any help any body could give me.
ETracker
ET

[Tommy]

Hi ETracker,

What 1 to 3 things are you going to change? Text, Mtext, Line, LWpoly, etc
Will it be automated in other words is the user going to pick the entities (as in selection set) or are they going to be same thing same place? Also paper or model space, I hope it is model cause I have no clue on paper, last time I worked with paper was before autocad .

Acad likes to save the projects as a seperate file, like autolisp.

[Tommy]

This is how to loop through and open each drawing in a directory

[VBA]
Sub LookInDir(WhichDir As String)
Dim Filed As String
Dim MyDwg As AcadDocument
Filed = Dir(WhichDir & "*.dwg")
While Filed <> vbNullString
Set MyDwg = ThisDrawing.Application.Documents.Open(WhichDir & Filed)
' this is where the modifing comes into play
MyDwg.Close
Wend
End Sub
Sub Main()
LookInDir "C:\ACAD\"
End Sub
[/VBA]

[ETracker]

Hi Tommy,

Thanks for your time to help get started with this task. I think I will be making the changes in model space and it will be Text. I will try the code that you have provide to see how it acts with these drawings. To help you understand what I am doing is, we have about 75 drawings that will remain the same except the customer number and Job number will need to be change to a new customer and Job number.

Again, thanks for your time and the sample code you have provided, I will post back to let you know how it goes.

ETracker (ET)

[Tommy]

ET I worked this out for you I got a lot of this through digging in the help files in ACAD. Let me know if you need more help, or if explainations are needed.

[VBA]
Sub LookInDir(WhichDir As String)
Dim Filed As String
Dim MyDwg As AcadDocument
Dim MyInfo(1 To 2) As String
MyInfo(1) = "FINALV"
MyInfo(2) = "IT WORKED"
Filed = Dir(WhichDir & "FINALV*.dwg")
While Filed <> vbNullString
Set MyDwg = ThisDrawing.Application.Documents.Open(WhichDir & Filed)
SelectText (MyInfo)
MyDwg.Save
Filed = Dir
Wend
End Sub
Sub Main()
LookInDir "C:\ACAD\"
End Sub

Sub SelectText(MyInfo)
Dim mode As Integer
Dim corner1(0 To 2) As Double
Dim corner2(0 To 2) As Double
Dim ssetObj As AcadSelectionSet
Dim gpCode(0) As Integer
Dim dataValue(0) As Variant
Dim I As Integer
Dim AA
Dim BB
Dim J As Integer
Dim groupCode As Variant, dataCode As Variant
Set ssetObj = ThisDrawing.SelectionSets.Add("JobText")
'get the limits of the drawing
AA = ThisDrawing.GetVariable("LIMMIN")
BB = ThisDrawing.GetVariable("LIMMAX")
'set the selection mode to window
mode = acSelectionSetWindow
' set the window to 30% of the lower right hand corner
corner1(0) = BB(0) - (BB(0) * 0.3): corner1(1) = AA(1) + (BB(1) * 0.3): corner1(2) = 0
corner2(0) = BB(0): corner2(1) = AA(1): corner2(2) = 0
gpCode(0) = 100
dataValue(0) = "TEXT"
groupCode = gpCode
dataCode = dataValue
ssetObj.Select mode, corner1, corner2, groupCode, dataCode
' itterate through the selection set to pick up the text you are looking for and replace
For I = 0 To ssetObj.Count - 1
If ssetObj(I).ObjectName = "AcDbText" Then
For J = LBound(MyInfo) To UBound(MyInfo) Step 2
If InStr(1, ssetObj(I).TextString, MyInfo(J)) > 0 Then
ssetObj(I).TextString = Replace(ssetObj(I).TextString, MyInfo(J), MyInfo(J + 1))
ssetObj(I).Update
End If
Next
End If
Next
Set ssetObj = Nothing
ThisDrawing.SelectionSets("JobText").Delete
End Sub

[/VBA]

Later