AutoCAD Title Block From EXCEL VBA (Archive) - AutoCAD Forums
AutoCAD Title Block From EXCEL VBA (Archive) - AutoCAD Forums
AutoCAD Title Block From EXCEL VBA (Archive) - AutoCAD Forums
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:
As I am not a Administrator on my PC (company policy) I can not install any programs of tools.
JG
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.
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
pitname = Getpitname(Newpitname)
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
'FilterDXFCode(1) = 2
'FilterDXFVal(1) = "SCHEDTEXT"
Set SS = ThisDrawing.SelectionSets.Add("pit1sel")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
attribs = SS.Item(Cntr).GetAttributes
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
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"
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
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
Like:
Distance (Position 4,5)
Elevation (Position 4,7)
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
PS the edit post button doesn't work either :( nor the smileys I have to copy and paste them
Steven-g nice one about sending commands to Autocad will keep a copy. I knew it could be done.
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
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
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).Update
attribs(3).Update
Sorry, I tried but couldn't figure out how to put my code in Code tags.
Pretty simple
Your Code Here =
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.
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
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 ' Value01 set in calling sub
attribs(1).TextString = xValue01
attribs(1).Update
End If
Alternatively, I have the code to save each drawing update in a TXT file that can be imported using ATTIN. But the ATTIN
function asks for the TXT file to be selected manually.
Is there any way to automate this so it always uses the same file?
I can then create the TXT file for each drawing within my script loop, then run ATTIN on each drawing individually. I know it
will take some time, but this script can be run overnight or even on weekends.
JG
re 61 attributes not really a problem either if the output file was like this, it will get a liitle more complicated if you have
multiple layouts and various atts to suit the cahnging layouts. Note what I am thinking about, attributes do not need to be
in order as it uses the position number for updating.
layout1,""
1,"attribute 1 value"
2,"attribute 2 value"
3,"rev 1"
4,"attribute 4 value"
layout2,""
1,"attribute 1 value"
2,"attribute 2 value"
3,"rev 2"
4,"attribute 4 value"
We need two things a excel that makes sense and a sample dwg.