Page 1 of 2 12 LastLast
Results 1 to 10 of 13

Thread: change text on CAD by excel sheet

  1. #1
    Login to Give a bone
    0

    Default 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.
    Attached Files Attached Files

  2. #2
    Login to Give a bone
    0

    Default Re: change text on CAD by excel sheet

    Urgently support please

  3. #3
    Member
    Join Date
    2008-02
    Posts
    48
    Login to Give a bone
    0

    Default 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.

    New folder.rar
    Last edited by grobnik; 2020-03-01 at 04:24 PM.

  4. #4
    Member
    Join Date
    2008-02
    Posts
    48
    Login to Give a bone
    0

    Default 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
    AugiTextReplaceProject.dvb
    Last edited by grobnik; 2020-03-01 at 03:51 PM.

  5. #5
    Login to Give a bone
    0

    Default Re: change text on CAD by excel sheet

    Quote Originally Posted by grobnik View Post
    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
    AugiTextReplaceProject.dvb
    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
    Attached Images Attached Images

  6. #6
    Member
    Join Date
    2008-02
    Posts
    48
    Login to Give a bone
    0

    Default 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

  7. #7
    Login to Give a bone
    0

    Default Re: change text on CAD by excel sheet

    really thanks for your support
    i add Autocad 2019 type library
    i facing 2 issues
    20.PNG
    30.PNG
    thanks again for your support
    Last edited by Ed Jobe; 2020-03-03 at 06:27 PM.

  8. #8
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    5,737
    Login to Give a bone
    0

    Default 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?
    C:> ED WORKING....

  9. #9
    Member
    Join Date
    2008-02
    Posts
    48
    Login to Give a bone
    0

    Default 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 - - -

    Quote Originally Posted by Ed Jobe View Post
    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?


    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

  10. #10
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    5,737
    Login to Give a bone
    0

    Default Re: change text on CAD by excel sheet

    Quote Originally Posted by grobnik View Post
    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.
    C:> ED WORKING....

Page 1 of 2 12 LastLast

Similar Threads

  1. Replies: 0
    Last Post: 2019-12-24, 06:25 PM
  2. Change CAD layer through Excel VBA or LISP
    By bagusdewantoro86762677 in forum VBA/COM Interop
    Replies: 5
    Last Post: 2019-02-14, 10:41 PM
  3. Replies: 0
    Last Post: 2015-10-25, 10:06 AM
  4. Link Sheet set to Sheet List Table and Excel
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 1
    Last Post: 2013-05-19, 05:52 AM
  5. Linking Excel Sheet in IDW with an Excel Sheet in IPT
    By Darkstar24 in forum Inventor - General
    Replies: 4
    Last Post: 2008-04-20, 06:14 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •