Printable View
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.
Urgently support please
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.
Please check and let me know.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
Attachment 107971
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.
Attachment 107973Code: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
really thanks for your supportQuote:
Originally Posted by grobnik
i little bit familiar with VBA with autocad
i try to run VBA while autocad file is open
i face below issue
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.
really thanks for your support
i add Autocad 2019 type library
i facing 2 issues
Attachment 107984
Attachment 107985
thanks again for your support
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?
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
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
According to the error message, the OP was trying to unload the project.Quote:
Originally Posted by grobnik
Hi,
We don't know the reasons because he would like to unload the procedure, however the procedure to unload it's correct.
We suggested how to fix the first point he highlighted concerning the SelectionSet, declaring as general object instead AcadSelectionSet.
If you have time try to download my solution and give me a feedback.
What I understand is:
He has inside the drawing several text related to a TAG, and would like to change based an excel list before created by himself or somebody.
So I created a selection set containing all text found in the drawing (Text are placed in a specific LAYER, named TAG), and a loop for comparing and substituting when comparison matches the excel cell.
Let me know your impression.
hi grobnik
i really appreciate your support
as i said before i am little knowledge of VBA
so what i did
1- i open autcad dwg.
2- select what i need to change.
3- open the excel file.
4- load .bas file.
5- run the VBA.
and that is the error i face now.
Attachment 108003
this part of procedure it has been used to find the final row address of Excel file,
Attachment 108007
procedure check from row 1 to row n inside excel file, until the cells contains an empty value checked by "", if found we can retrive the maximum row used in the excel file, and we can save time instead check the entire worksheet cells inside column A.
Of course in order to do this, it is necessary to have excel opened, with current worksheet containing value to find and value for substitution.
Please note that we are inside autocad workplace and we are pointing to excel by object WKRS object variable, defined as Global inside main procedure, if this it's not working properly we cannot have the access to Excel file.
Let me know