1 Attachment(s)
change text on CAD by excel sheet
Hello Everyone
I have drawing need to change text on it using excel sheet
For example:
COLUMN A COLUMN B
text to find text to replace
town London
capital United Kingdom
I need VBA code allow me to change complete drawing on time bec i have around 800 drawing
i upload one drawing as sample
all tags in red color need to change individually.
Re: change text on CAD by excel sheet
1 Attachment(s)
Re: change text on CAD by excel sheet
Hi,
attached a simple project.
Procedure:
you have to open your excel file, see attached, replace text and run the procedure, opening the project in Autocad VBA.
I made a simple sub in order to check the last row not empty in excel file.
In order to test exactly the text replacement, I made before a txt file attached with all tags, imported inside an excel sheet and on next side excel column I made a simple addition of NEW text to previous TAG.
The procedure it's not so quickly, of course it's depends from amount of TAG to be replaced, and amount of object inside the dwg, because the TAG search to be replaced inside the DWG will be in all object inside the DWG.
Search could be refined, I'll give you another version soon.
Code:
Global MaxRowN As Integer
Global MaxRowAdd As Variant
Global GetExcelAppl As Object
Global WRKBS As Object
Global WKRS As Object
Sub RepText_From_Excel()
Dim GetExcelAppl As Object
Dim DWGSearchText As Object
'Open ("C:\Users\Utente\Downloads\Compressed\New folder\TagList.txt") For Output As #1
ExRow = 2
ExCol = 1
Set GetExcelAppl = GetObject(, "Excel.Application")
Set WRKBS = GetExcelAppl.ActiveWorkbook
Set WKRS = GetExcelAppl.ActiveSheet
GetExcelAppl.Visible = True
GetExcelAppl.Application.ScreenUpdating = False
MaxRow
For Each DWGSearchText In ThisDrawing.ModelSpace ' Per ogni entità nello spazio modello
If DWGSearchText.Layer = "TAG" Then
If TypeOf DWGSearchText Is AcadText Then
Debug.Print DWGSearchText.TextString
'Print #1, DWGSearchText.TextString
For Each Cella In WKRS.CELLS.Range(MaxRowAdd)
MyRow = Cella.row
MyCol = Cella.column
If StrComp(DWGSearchText.TextString, Cella.Value, vbTextCompare) = 0 Then
DWGSearchText.TextString = WKRS.CELLS(Cella.row, MyCol + 1).Value
End If
Next
End If
End If
Next
ThisDrawing.Regen acAllViewports
End Sub
Sub MaxRow()
R = 1
C = 1
Do
R = R + 1
Loop Until WKRS.CELLS(R, C) = ""
MaxRowAdd = "A2:" & "A" & R - 1
End Sub
Please check and let me know.
Attachment 107971
1 Attachment(s)
Re: change text on CAD by excel sheet
Hi here attached a new version of procedure. execution time shall be little bit lower, because it have been made a selection set of all text, and only that inside TAG layer shall be selected for check of modification compared with excel file.
In this case we will have 340 items to replace and application need few minutes (with other tasks running, and I7 processor).
Again let me know.
Code:
Global MaxRowAdd As Variant
Global GetExcelAppl As Object
Global MySelection As AcadSelectionSet
Global ExRow
Global ExCol
Global WRKBS As Object
Global WKRS As Object
Sub RepText_From_Excel()
Dim GetExcelAppl As Object
Dim DWGSearchText As Object
'Open ("C:\Users\Utente\Downloads\Compressed\New folder\TagList.txt") For Output As #1
Count = 0
Set GetExcelAppl = GetObject(, "Excel.Application")
Set WRKBS = GetExcelAppl.ActiveWorkbook
Set WKRS = GetExcelAppl.ActiveSheet
GetExcelAppl.Visible = True
GetExcelAppl.Application.ScreenUpdating = False
MaxRow
ExRow = 2
ExCol = 1
SelectionSetFilterText
For Each DWGSearchText In MySelection ' ThisDrawing.ModelSpace ' Per ogni entità nello spazio modello
If DWGSearchText.Layer = "TAG" Then
If TypeOf DWGSearchText Is AcadText Then
Debug.Print DWGSearchText.TextString
'Print #1, DWGSearchText.TextString
For Each Cella In WKRS.CELLS.Range(MaxRowAdd)
If StrComp(DWGSearchText.TextString, Cella.Value, vbTextCompare) = 0 Then
MyRow = Cella.row
MyCol = Cella.column
DWGSearchText.TextString = WKRS.CELLS(MyRow, MyCol + 1).Value
Count = Count + 1
End If
Next
End If
End If
Next
ThisDrawing.Regen acAllViewports
MsgBox "Replaced " & Count & " Text Items"
End Sub
Sub MaxRow()
ExRow = 1
ExCol = 1
Do
ExRow = ExRow + 1
Loop Until WKRS.CELLS(ExRow, ExCol) = ""
MaxRowAdd = "A2:" & "A" & ExRow - 1
End Sub
Sub SelectionSetFilterText()
Dim filterType(1) As Integer
Dim filterData(1) As Variant
On Error Resume Next
On Error GoTo 0
For Each MySelection In ThisDrawing.SelectionSets
If MySelection.Name = "PP1" Then MySelection.Delete
Next MySelection
Set MySelection = ThisDrawing.SelectionSets.Add("PP1")
filterType(0) = 0
filterType(1) = 8
filterData(0) = "TEXT,MTEXT"
filterData(1) = "TAG"
MySelection.Select acSelectionSetAll, , , filterType, filterData
End Sub
Attachment 107973
1 Attachment(s)
Re: change text on CAD by excel sheet
Quote:
Originally Posted by
grobnik
Hi here attached a new version of procedure. execution time shall be little bit lower, because it have been made a selection set of all text, and only that inside TAG layer shall be selected for check of modification compared with excel file.
In this case we will have 340 items to replace and application need few minutes (with other tasks running, and I7 processor).
Again let me know.
Code:
Global MaxRowAdd As Variant
Global GetExcelAppl As Object
Global MySelection As AcadSelectionSet
Global ExRow
Global ExCol
Global WRKBS As Object
Global WKRS As Object
Sub RepText_From_Excel()
Dim GetExcelAppl As Object
Dim DWGSearchText As Object
'Open ("C:\Users\Utente\Downloads\Compressed\New folder\TagList.txt") For Output As #1
Count = 0
Set GetExcelAppl = GetObject(, "Excel.Application")
Set WRKBS = GetExcelAppl.ActiveWorkbook
Set WKRS = GetExcelAppl.ActiveSheet
GetExcelAppl.Visible = True
GetExcelAppl.Application.ScreenUpdating = False
MaxRow
ExRow = 2
ExCol = 1
SelectionSetFilterText
For Each DWGSearchText In MySelection ' ThisDrawing.ModelSpace ' Per ogni entità nello spazio modello
If DWGSearchText.Layer = "TAG" Then
If TypeOf DWGSearchText Is AcadText Then
Debug.Print DWGSearchText.TextString
'Print #1, DWGSearchText.TextString
For Each Cella In WKRS.CELLS.Range(MaxRowAdd)
If StrComp(DWGSearchText.TextString, Cella.Value, vbTextCompare) = 0 Then
MyRow = Cella.row
MyCol = Cella.column
DWGSearchText.TextString = WKRS.CELLS(MyRow, MyCol + 1).Value
Count = Count + 1
End If
Next
End If
End If
Next
ThisDrawing.Regen acAllViewports
MsgBox "Replaced " & Count & " Text Items"
End Sub
Sub MaxRow()
ExRow = 1
ExCol = 1
Do
ExRow = ExRow + 1
Loop Until WKRS.CELLS(ExRow, ExCol) = ""
MaxRowAdd = "A2:" & "A" & ExRow - 1
End Sub
Sub SelectionSetFilterText()
Dim filterType(1) As Integer
Dim filterData(1) As Variant
On Error Resume Next
On Error GoTo 0
For Each MySelection In ThisDrawing.SelectionSets
If MySelection.Name = "PP1" Then MySelection.Delete
Next MySelection
Set MySelection = ThisDrawing.SelectionSets.Add("PP1")
filterType(0) = 0
filterType(1) = 8
filterData(0) = "TEXT,MTEXT"
filterData(1) = "TAG"
MySelection.Select acSelectionSetAll, , , filterType, filterData
End Sub
Attachment 107973
really thanks for your support
i little bit familiar with VBA with autocad
i try to run VBA while autocad file is open
i face below issue
1 Attachment(s)
Re: change text on CAD by excel sheet
Ok,
first of all, check if some reference are missing, by opening, inside development tools, the menu tabs tools, reference, and look if you have some "MISSING" word somewhere before the library name.
if yes, try to find the same library perhaps oldest, due to I developed with Autocad 2019, Mechanical version.
Attachment 107975
As second issue try to change Name for example MyMySele everywhere (best is find and replace inside all module).
As third issue if nothing by issue 1 or 2, try to change definition of variable type defining as "OBJECT" instead AcadSelectionSet
In any case, please note that inside your drawing there are some "TAG" I guess, inside blocks, these will be not considered inside the procedure, due to you talk about text and not blocks.
For blocks, procedure will be different.
Try to do this and let me know.
2 Attachment(s)
Re: change text on CAD by excel sheet
really thanks for your support
i add Autocad 2019 type library
i facing 2 issues
Attachment 107984
Attachment 107985
thanks again for your support
Re: change text on CAD by excel sheet
You don't unload vba projects via APPLOAD. You have to use VBAMAN.
As for the second "problem", we need more information other than just a jpg. Did you set a breakpoint? Did you try Step Into (F8)? What were you doing when execution stopped?
1 Attachment(s)
Re: change text on CAD by excel sheet
Other solution could be use your own project, and import attached BAS file.
Please note that for your issue concerning the selection set I made a modification to procedure substituting, as I wrote you before, with general object definition.
See attached (I inserted also an excel file structure)
Let us know
Attachment 107987
- - - Updated - - -
Quote:
Originally Posted by
Ed Jobe
You don't unload vba projects via APPLOAD. You have to use VBAMAN.
As for the second "problem", we need more information other than just a jpg. Did you set a breakpoint? Did you try Step Into (F8)? What were you doing when execution stopped?
Hi Ed,
I use always "load Application" procedure and it's working fine. The procedure has been made by Autocad VBA, never used pure Visual Basic, or Visual Studio.
If it is not working I suggest to fix VBA application inside Autodesk Application.
As second issue I replaced declaration as generic object variable type. It shall work fine
Re: change text on CAD by excel sheet
Quote:
Originally Posted by
grobnik
Hi Ed,
I use always "load Application" procedure and it's working fine.
According to the error message, the OP was trying to unload the project.