|
|
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
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
New folder.rar
Last edited by grobnik; 2020-03-01 at 04:24 PM.
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.
AugiTextReplaceProject.dvbCode: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
Last edited by grobnik; 2020-03-01 at 03:51 PM.
Re: change text on CAD by excel sheet
really thanks for your supportOriginally 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
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.
RefLibrary.jpg
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.
Last edited by grobnik; 2020-03-02 at 08:07 AM. Reason: Block TAG Note added
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 (F? What were you doing when execution stopped?
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
TextChangeProcedure.rar
- - - Updated - - -
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 (F
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
Posting Permissions
Reply With Quote