Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
0% found this document useful (0 votes)
393 views7 pages

AutoCAD Title Block From EXCEL VBA (Archive) - AutoCAD Forums

Download as pdf or txt
Download as pdf or txt
Download as pdf or txt
You are on page 1/ 7

JGupte 21st Aug 2017, 03:51 am

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 21st Aug 2017, 05:27 am


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

JGupte 21st Aug 2017, 05:46 am


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 21st Aug 2017, 06:15 am


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 21st Aug 2017, 06:21 am


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

amukul 21st Aug 2017, 06:26 am


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 21st Aug 2017, 06:28 am


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 21st Aug 2017, 12:10 pm


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 21st Aug 2017, 12:49 pm


Please read the Code Posting Guidelines (http://www.cadtutor.net/forum/showthread.php?t=9184) and edit your Code to
be included in Code Tags.
Your Code Here =
Your Code Here

steven-g 21st Aug 2017, 01:42 pm


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 21st Aug 2017, 01:46 pm


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 21st Aug 2017, 10:46 pm


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

BIGAL 22nd Aug 2017, 02:02 am


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.
[code]
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

JGupte 22nd Aug 2017, 03:59 am


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 22nd Aug 2017, 06:15 am


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 22nd Aug 2017, 06:23 am


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 22nd Aug 2017, 08:16 am


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 22nd Aug 2017, 02:16 pm


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

JGupte 24th Aug 2017, 02:01 am


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 24th Aug 2017, 02:03 am


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


JGupte 24th Aug 2017, 02:07 am
BIGAL,

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.

I don't really care how it is done, just need it done.

All help appreciated.

JG

BIGAL 24th Aug 2017, 02:35 am


Dumping out a txt file makes it even easier as you are not relying on the link to excel. A lisp file can be called as part of a
script file to do changes on multiple dwgs like changing certain attributes.

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"

the script would be something like


open dwg1 (doupatts dwg1.txt) close Y
open dwg3 (doupatts dwg3.txt) close Y
open dwg4 (doupatts dwg4.txt) close Y

We need two things a excel that makes sense and a sample dwg.

You might also like