AutoCAD Title Block from EXCEL VBA

[JGupte]

Hi All,

 

I am trying to write a VBA script that will run from inside an Excel spread sheet to update the title block fields from values in the spreadsheet.

 

I have been able to use ATTOUT to export the existing values to a TXT file and ATTIN to import the changed values. But I need to drive this from Excel VBA.

In plain English, what I need to do is:

 

Loop through all dwg files in a list

for each dwg file,

find the Title block values in my spread sheet and export them to a txt file (in the correct format)

open the dwg file

import the txt file (ATTIN)

save and close the dwg file

Delete the txt file

Loop

 

I am fairly proficient in Excel VBA, but not in AutoCAD.

So far, I can create a link to AutoCAD and open the dwg file, then save and close it.

 

But I can't figure out how to automate the ATTIN function.

 

As I am not a Administrator on my PC (company policy) I can not install any programs of tools.

 

Any help would be appreciated.

 

JG

[BIGAL]

1st up search here lots of examples that do title block update. You may be better going the other way and drive excel from Autocad this can be a simple get cell and put atribute. Likewise I am sure you can drive Autocad from excel. I have posted a vba block attribute updating code that may be usefull as I am not sure about driving from excel. There is basicly two ways to find the correct attribute to change either use its tag name or use its position order, the second method is the example here with the 1st attribute starting at 0 see attrib(0)

 

Most of the excel/Autocad examples use lisp in particular code written in Vlisp is very similar method.

 

getexcel.lsp is what I use there are others, it does have methods that may enable excel to control I have never had to do it that way.

 

Public Sub ModifyPitSchedule1()
' adds single pt

Dim SS As AcadSelectionSet
Dim objENT As AcadEntity
Dim Count, Cntr As Integer
Dim Newpitname As String
Dim pitname As String
Dim FilterDXFCode(0) As Integer
Dim FilterDXFVal(0) As Variant
Dim PitNameSelect As AcadObject
Dim basepnt, pt1, pt2, pt3 As Variant
Dim attribs As Variant

'On Error Resume Next

Newpitname = "1"   'dummy to pass then return changed
BLOCK_NAME = "SCHEDTEXT"

pitname = Getpitname(Newpitname)

MsgBox "pitname selected is " & pitname

FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
'FilterDXFCode(1) = 2
'FilterDXFVal(1) = "SCHEDTEXT"

Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal


For Cntr = 0 To SS.Count - 1

If SS.Item(Cntr).Name = BLOCK_NAME Then

 
  attribs = SS.Item(Cntr).GetAttributes
       
    If attribs(0).TextString = pitname Then
      pt1 = ThisDrawing.Utility.GetPoint(, " pick first point")

      txtx1 = CStr(FormatNumber(pt1(0), 3))
      TXTY1 = CStr(FormatNumber(pt1(1), 3))
       
       attribs(1).TextString = txtx1
       attribs(2).TextString = TXTY1
       
       attribs(1).Update
       attribs(2).Update
'        ThisDrawing.Application.Update
' try this
       Cntr = SS.Count
    
    Else: End If
     
Else: End If

Next Cntr
ThisDrawing.SelectionSets.Item("pit1sel").Delete
End Sub

GetExcel.zip

Edited August 22, 2017 by BIGAL

[JGupte]

Hi BIGAL,

Thanks for the reply.

 

 

The reason for driving this from Excel instead of AutoCAD is that we need to update several thousand drawings with data in one Excel spread sheet.

 

 

I would like to use the tag name method, and update an existing tag with a value from the spread sheet.

 

 

E.G.

Tag Name = "TPDDRAWINGNO"

Current value = "TPDDRAWINGNO" (from template"

Desired value = "SLR-ALS-D50-CSR-DWG-063201"

 

 

These will all be in the title block.

 

 

The procedure will loop through the spread sheet and update each drawing appropriately.

I have my data in one line per drawing with the tags as the column headings.

 

 

JG

[steven-g]

Can you post the code that you have up to now. It would be easier for someone to help if they have a starting point to work from.

[JGupte]

I don't really have much code yet. Just the basic to start AutoCAD and open the drawing.

 

 

Sub Open_DWG()
   On Error Resume Next
   Dim strDrawing As String
   On Error Resume Next
   Set ACAD = GetObject(, "AutoCAD.Application")
   If Err.Description > vbNullString Then
       Err.Clear
       Set ACAD = CreateObject("AutoCAD.Application")
   End If
   ACAD.Visible = True
   xDWGPath = "C:\Users\297560\Documents\Development\AutoCAD Update\"
   Range("A2").Select
   xDWGFile = ActiveCell & ".dwg"
   xDWGFull = xDWGPath & xDWGFile
   ACAD.Documents.Open (xDWGPath & xDWGFile)
   
   
End Sub

 

 

I am trying to create the project from scratch, and trying various bits of code I am finding on the web.

 

 

When creating Excel macros, I usually start by recording a macro to do the basic stuff I want, then modifying the code to add loops, error checking, etc.

 

 

But in AutoCAD I can't figure out how to record the macro (I tried Action Recorder, but could not find how to edit the code generated).

 

 

JG

Edited May 21, 2018 by SLW210
Code Tags

[amukul]

I want to autocad text command apply from excel cell- like "-text "&Crossing!B3&",-4.5 0 Distance"

but i can only one text write from one cell, how can i do multi text write from one excell text to autocad from different position

[amukul]

I want to autocad text command apply from excel cell- like "-text "&Crossing!B3&",-4.5 0 Distance"

but i can only one text write from one cell, how can i do multi text write from one excell text to autocad from different position..

 

Like:

Distance (Position 4,5)

Elevation (Position 4,7)

 

Please help any body

[steven-g]

I can't comment on the merits of working this way, I'm new to full Autocad but was interested to find out how to issue commands from Excel, so building on what you posted, this code will update the attributes in all the drawings in a list.

 

 

I used the -attedit command as this doesn't require you to write multiple txt files and so just a simple loop will suffice, I had drawing names in column A (starting at A2) then old attribute values in column B and new values in column C, I only ran this on 3 simple drawings and each one only had a single layout and attributed block, so there is no error checking or changing to the correct layout, but it worked. I would advise making a complete backup of any folders you use before running any Code, and take a look in the help files about the -attedit command for possible changes in the layout of how you can use it.

 

 

Sub Open_DWG()
On Error Resume Next
Dim strDrawing As String
Dim acadCmd As String
On Error Resume Next
Set ACAD = GetObject(, "AutoCAD.Application")
If Err.Description > vbNullString Then
Err.Clear
Set ACAD = CreateObject("AutoCAD.Application")
End If
ACAD.Visible = True
xDWGPath = "D:\Autodesk support\Drawings\"
'xDWGPath = "C:\Users\297560\Documents\Development\AutoCAD Update\"
For x = 2 To 4
Cells(x, 1).Select
xDWGFile = ActiveCell & ".dwg"
xDWGFull = xDWGPath & xDWGFile
ACAD.Documents.Open (xDWGPath & xDWGFile)
acadCmd = "-attedit n n " & vbCr & "TPDRAWINGNO" & vbCr & Cells(x, 2).Value & vbCr & Cells(x, 2).Value & vbCr & Cells(x, 3).Value
ACAD.ActiveDocument.SendCommand acadCmd & vbCr
ACAD.ActiveDocument.SendCommand "qsave close" & vbCr
Next
End Sub

[SLW210]

Please read the Code Posting Guidelines and edit your Code to be included in Code Tags.[NOPARSE]

Your Code Here[/NOPARSE]

=

Your Code Here

[steven-g]

I have to add here the code posting tags icon doesn't do anything for me, not sure if it's a browser problem (IE) or just broken on the site, but I have to manually type in the CODE tags

[steven-g]

And I can never remeber if it a back slash or forward slash

 

 

PS the edit post button doesn't work either nor the smileys I have to copy and paste them

[JGupte]

Sorry, I tried but couldn't figure out how to put my code in Code tags.

[BIGAL]

I have just got used to typing manually put this at start without the space can do via edit no probs some time I type one wrong and have to go back and fix.

[ c o d e ]

end is

[ / c o d e]

 

Steven-g nice one about sending commands to Autocad will keep a copy. I knew it could be done.

 

You can call lisp from VBA makes an interesting idea.

ThisDrawing.SendCommand "(load " + Chr(34) + "s:/autodesk/vba/xxxblockedit.lsp" + Chr(34) + ")" + vbCr

Edited August 22, 2017 by BIGAL

[JGupte]

Hi BIGAL & steven-g

 

 

I tried steven-g's method, but that requires that I know what the original value of the tag is.

Steven - is there any way of bypassing the original value requirement ? Maybe a wild card (tried * but that does not work).

 

 

or

 

 

The ATTIN function (in ATTOUT.LSP) would work, but it prompts for an input file. And I don't know LISP, so can't figure out how to modify it.

 

 

BIGAL - can you send me a modified version of ATTOUT.LSP or tell me which line to modify?

I only need the ATTIN part.

 

 

JG

[steven-g]

The -attedit requires that you know the existing value, and will also allow you to add things like block and tag values so that you can narrow down to the exact block attribute that you want. As opposed to the attin command that has the attribute handle to work with. You stated that you already had used the attout command which means you have the old attribute values there, and if you are working in Excel to keep a record of them then those values must be in Excel.

If not then it shouldn't be too big of a problem to adapt the code above to use the attin command, the method used to send a command to Autocad from Excel VBA uses the line containing

.ActiveDocument.SendCommand 

[JGupte]

We have over 2000 drawings that need to be updated by this script. So using the ATTOUT command for each would be very tedious.

 

 

I am using the output from the ATTOUT from one drawing (the template that all the others have been created from) to get the block and tag keys. I will then update all drawings with the values specified in my spreadsheet, irrespective of what is there currently.

 

 

The reason for doing this is to apply standard values, something which the draftsmen have not been adhering to thus far.

 

 

I know (thanks to BIGAL) how to send the command to AutoCAD to run my modified ATTIN LSP. But the ATTIN requires a file to be selected, and I want to run this automatically (doubt anyone wants to sit there and select 2000 input files).

 

 

I am trying to modify the ATTIN function with code that BIGAL supplied.

 

 

JU

[BIGAL]

I have posted a vba block attribute updating code

 

You should have looked closer at the VBA that I posted it does not require tag names or Attin, it use attribute creation order works for 99% of time wont go into now. So will work with any block but you must obviously know its name. You dont even have to be in same space/layout as block and it will update. Double click a block and you will see the order.

 

If I have 5 attributes and want to update 2nd and 4th attribute something like this will work.

 

attribs(1).TextString = "Freds plans"
attribs(3).TextString = "Revision A"
       
attribs(1).Update
attribs(3).Update

[SLW210]

I have to add here the code posting tags icon doesn't do anything for me, not sure if it's a browser problem (IE) or just broken on the site, but I have to manually type in the CODE tags

 

Sorry, I tried but couldn't figure out how to put my code in Code tags.

 

Pretty simple [NOPARSE]

Your Code Here[/NOPARSE]

=

Your Code Here

You can type it in manually or use the # which will (maybe) insert the tags.

 

Some of the latest browsers seem to have a problem with the WYSIWYG reply box. Go to Settings>General Settings and scroll to Miscellaneous Options then under Message Editor Interface select the bottom Standard Editor.

[JGupte]

You should have looked closer at the VBA that I posted it does not require tag names or Attin, it use attribute creation order works for 99% of time wont go into now. So will work with any block but you must obviously know its name. You dont even have to be in same space/layout as block and it will update. Double click a block and you will see the order.

 

 

 

Hi BIGAL,

 

 

I did look at your code, and tried to modify it to my requirements, but could not get it to work.

 

 

I have 61 attributes I need to change (if they are not empty), and I tried to loop each one. But nothing happened to my drawing.

 

 

Sub Update_DWG() ' Performed in a loop for each drawing (over 2000)
   On Error Resume Next
   Set ACAD = GetObject(, "AutoCAD.Application")
   If Err.Description > vbNullString Then
      Err.Clear
      Set ACAD = CreateObject("AutoCAD.Application")
   End If
   ACAD.Visible = True
   xDWGPath = "C:\Users\297560\Documents\Development\AutoCAD Update\"
   xDWGFile = xDWGNo & ".dwg" '  - set in a calling sub
   xDWGFull = xDWGPath & xDWGFile
   ACAD.Documents.Open (xDWGPath & xDWGFile)



'

   BLOCK_NAME = "SLR_TfNSW_A1_Tblock"
   FilterDXFCode(1) = 2
   FilterDXFVal(1) = "SLR_TfNSW_A1_Tblock"
   SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
   For Cntr = 0 To SS.Count - 1
   If SS.Item(Cntr).Name = BLOCK_NAME Then
   If xValue01 <> "" Then
      attribs(1).TextString = xValue01
      attribs(1).Update
   End If


   ACAD.ActiveDocument.SendCommand "qsave close" & vbCr

[JGupte]

Sorry, posted before I was ready

 

 

Hi BIGAL,

 

 

I did look at your code, and tried to modify it to my requirements, but could not get it to work.

 

 

I have 61 attributes I need to change (if they are not empty), and I tried to loop each one. But nothing happened to my drawing.

 

 

Sub Update_DWG() ' Performed in a loop for each drawing (over 2000)
   On Error Resume Next
   Set ACAD = GetObject(, "AutoCAD.Application")
   If Err.Description > vbNullString Then
      Err.Clear
      Set ACAD = CreateObject("AutoCAD.Application")
   End If
   ACAD.Visible = True
   xDWGPath = "C:\Users\297560\Documents\Development\AutoCAD Update\"
   xDWGFile = xDWGNo & ".dwg" '  - set in a calling sub
   xDWGFull = xDWGPath & xDWGFile
   ACAD.Documents.Open (xDWGPath & xDWGFile)



' problem lies here?

   BLOCK_NAME = "SLR_TfNSW_A1_Tblock"
   FilterDXFCode(1) = 2
   FilterDXFVal(1) = "SLR_TfNSW_A1_Tblock"
   SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
   For Cntr = 0 To SS.Count - 1
   If SS.Item(Cntr).Name = BLOCK_NAME Then
   If xValue01 <> "" Then ' Value01 set in calling sub
      attribs(1).TextString = xValue01
      attribs(1).Update
   End If

'there are 60 more Values I loop through

   ACAD.ActiveDocument.SendCommand "qsave close" & vbCr