Jump to content
barakar42

VBA AutoCAD command line variables

Recommended Posts

PeterPan9720
5 minutes ago, barakar42 said:

Thanks Peter, I can see that now. I'm going to try and edit the values now.

 

Your help has been invaluable! 😀

🧙‍♂️

Share this post


Link to post
Share on other sites
PeterPan9720
1 hour ago, barakar42 said:

Thanks Peter, I can see that now. I'm going to try and edit the values now.

 

Your help has been invaluable! 😀

Please note that the attributes array sequence will follow the sequence as the attributes had been created inside the block (just a note). Of course remember the sequence it is impossible so the debug option will help you more. 

Share this post


Link to post
Share on other sites
PeterPan9720

Just to help you more with the Attribute list array, here below a code that after the Attribute Extraction will fill each attribute on template drawing with AttrbuteArray index sequence and related prompt name (TAGSTRING).

Please Check your template there are a lot of duplicated attributes, or attributes not well defined see red text inside the picture below.

The consequence of the duplicated attribute Name could be a not well identification inside an automatic procedure, as you are trying to do, for own value modification with TEXTSTRING property.

Usually each block attribute shall be defined by a TAG and PROMPT, followed by VALUE if any.

The PROMPT is the TAGSTRING property and the VALUE is the TEXTSTRING property.

image.png.3819301ef8c420c0ccac0d6f03bf2a58.png

'previous code
'........
Next iCount

If IsEmpty(AttributeList) Then
    GoTo EndMacro
    Else
For QQ = LBound(AttributeList) To UBound(AttributeList)
    AttributeList(QQ).TextString = AttributeList(QQ).TagString & " " & QQ
Next
    End If

EndMacro:
End Sub

The Lbound and Ubound function are used to catch the lower and upper count index of array.

If I can suggest you a little modification the additional rev. block could be deleted and inserted in the main title block, in this way if not addition drawing revision could be inserted editing the title block attributes.

 

Attached your template with result.

 

CXXXX-E-000.dwg

Edited by PeterPan9720

Share this post


Link to post
Share on other sites
PeterPan9720

Hi  barakar42,

here attached your template revised with a unique title block, and without duplicated attributes name.

The code did not change, you will have only increase the amount of Array result of TITLE BLOCK GetAttributes function (See Attributelist array variable)

If you want to change the attributes sequence without redefining the block you can use 

  • Click Drafting tab > Block panel > Block Editor.
  • At the Command prompt, enter BATTORDER.
  • In the Attribute Order Dialog Box, drag rows to specify the order in which attributes are to be listed.

 

If you redefine the block attribute TAG or POSITION, I suggest to delete from drawing the TITLE BLOCK block and insert again @0,0 coordinates.

When you will insert again into the drawing LAYOUT a form window with attributes form filling value request will appear, you can fill or press only OK.

 

ACTUAL SEQUENCE IS

 

TAG   SEQUENCE
DRAWINGTITLELINE1   0
DRAWINGTITLELINE2   1
CLIENT   2
SITENAME   3
DRAWNBY   4
DATE_DRAWN_A   5
DRAWINGNO   6
DRAWING_NO_2   7
ISSUE   8
SCALE   9
AMEND_ISSUE_0   10
AMENDMENT_0   11
INITIALS_DES_BY_0   12
INITIALS_CHK_BY_0   13
INITIALS_APP_BY_0   14
DATE_DRAWN_0   15
AMEND_ISSUE_1   16
AMENDMENT_1   17
INITIALS_DES_BY_1   18
INITIALS_CHK_BY_1   19
INITIALS_APP_BY_1   20
DATE_DRAWN_1   21
AMEND_ISSUE_2   22
AMENDMENT_2   23
INITIALS_DES_BY_2   24
INITIALS_CHK_BY_2   25
INITIALS_APP_BY_2   26
DATE_DRAWN_2   27
AMEND_ISSUE_3   28
AMENDMENT_3   29
INITIALS_DES_BY_3   30
INITIALS_CHK_BY_3   31
INITIALS_APP_BY_3   32
DATE_DRAWN_3   33
AMEND_ISSUE_4   34
AMENDMENT_4   35
INITIALS_DES_BY_4   36
INITIALS_CHK_BY_4   37
INITIALS_APP_BY_4   38
DATE_DRAWN_4   39

CXXXX-E-000_unique title block.dwg

Edited by PeterPan9720

Share this post


Link to post
Share on other sites
PeterPan9720

Just to increase your VBA knowledge here partial code to have access to several layout by VBA.

 

MyLay = acadDoc.PaperSpace.Count 

 

'acadDoc is coming from previous code.. if you want to have access inside Autocad development Area you can use ThisDrawing instead acadDoc and of course remove the declaration of acadApp & acadDoc.


    For XX = 0 To MyLay
    acadDoc.ActiveLayout = acadDoc.Layouts.Item(XX)

'.... do something here ...

   Next XX

Unfortunately seems that the order as you are viewing several layout on drawing does not matches with Item(1).... to item(n) properties used in the code, this my experience, some other developer expert could help you more if need.

 

I solved in the past experience adding a number after layout name fro example  NAME  Sh1, NAME  Sh2 and so on. 

Please note that if you use the same "TITLE BLOCK" for all layouts you don't need the update the block in each layout, because it's already defined inside the drawing and it will be the same for all layouts, with the same attributes contents.

Share this post


Link to post
Share on other sites
barakar42

Hi Peter, 

 

Thanks for that. I'll give it a go when I get a chance at work

Share this post


Link to post
Share on other sites
barakar42

Hi Peter,

 

I've been trying to use your amazing code that you've kindly helped me with, but i'm struggling to use it, due to me not being the best with VBA.

 

I'm having trouble actually changing the attributes to different values. 

 

Even if i try and assign an attribute a cell value, it doesn't work. I'm not sure what i'm doing wrong

 

Share this post


Link to post
Share on other sites
PeterPan9720
1 hour ago, barakar42 said:

Hi Peter,

 

I've been trying to use your amazing code that you've kindly helped me with, but i'm struggling to use it, due to me not being the best with VBA.

 

I'm having trouble actually changing the attributes to different values. 

 

Even if i try and assign an attribute a cell value, it doesn't work. I'm not sure what i'm doing wrong

 

Hi,

did you made modification to TITLE BLOCK attributes like I suggested you. Could be some duplicated attributes, but shall be very simple.

For a double check you can write below code, after block found by previous code and attributes array populated:

For QQ = LBound(AttributeList) To UBound(AttributeList)
    Debug.Print QQ, AttributeList(QQ).TextString
Next

In order to view complete attribute string with own related position inside the array you should open the IMMEDIATE WINDOW (Vie menu option) and with above code attributes shall be printed locally on such window.

When ever are you sure to modify the correct attribute with AttributeList(QQ).TextString="NEW VALUE" should it work, as alternative give me your code I'll check.

Edited by PeterPan9720

Share this post


Link to post
Share on other sites
PeterPan9720
1 minute ago, PeterPan9720 said:

Hi,

did you made modification to TITLE BLOCK attributes like I suggested you. Could be some duplicated attributes, but shall be very simple.

For a double check you can write below code, after block found by previous code and attributes array populated:


For QQ = LBound(AttributeList) To UBound(AttributeList)
    Debug.Print QQ, AttributeList(QQ).TextString
Next

In order to view complete attribute string with own related position inside the array you should open the IMMEDIATE WINDOW (Vie menu option) and with above code attributes shall be printed locally on such window.

When ever are you sure to modify the correct attribute with AttributeList(QQ).TextString="NEW VALUE" should it work, as alternative give me your code I'll check.

 

Edited by PeterPan9720

Share this post


Link to post
Share on other sites
barakar42

I'm just honestly getting really confused over it all now.

 

 

You've got "  For XX = 0 To MyLay"  and  "For QQ = LBound(AttributeList) To UBound(AttributeList)"

 

so does XX go through all the layouts and then is QQ the attributes?

 

I'm using the modified block you attached earlier. 

 

So i think it works by going through each attribute (QQ) on each layer (XX)

 

So should the code be something like:

 

 For XX = 0 To MyLay
    acadDoc.ActiveLayout = acadDoc.Layouts.Item(XX)

If IsEmpty(attributelist) Then
    GoTo EndMacro
    Else
For QQ = LBound(attributelist) To UBound(attributelist)
    attributelist(QQ).TextString = attributelist(QQ).TagString & " " & QQ

 

''[attribute 2 to change to value in N20]

''[attribute 3 to change to value in N22]

''[attribute 5 to change to value to current date]

''[attribute 6, first 5 characters to change to value in N18]

''[attribute 7, first 5 characters to change to value in N18]

 

''{not figured this bit of the code out yet}

 


Next
    End If

EndMacro:

   Next XX

 

 

 

 

Share this post


Link to post
Share on other sites
PeterPan9720
1 hour ago, barakar42 said:

I'm just honestly getting really confused over it all now.

 

 

You've got "  For XX = 0 To MyLay"  and  "For QQ = LBound(AttributeList) To UBound(AttributeList)"

 

so does XX go through all the layouts and then is QQ the attributes?

 

I'm using the modified block you attached earlier. 

 

So i think it works by going through each attribute (QQ) on each layer (XX)

 

So should the code be something like:

 

 For XX = 0 To MyLay
    acadDoc.ActiveLayout = acadDoc.Layouts.Item(XX)

If IsEmpty(attributelist) Then
    GoTo EndMacro
    Else
For QQ = LBound(attributelist) To UBound(attributelist)
     

 

''[attribute 2 to change to value in N20]

''[attribute 3 to change to value in N22]

''[attribute 5 to change to value to current date]

''[attribute 6, first 5 characters to change to value in N18]

''[attribute 7, first 5 characters to change to value in N18]

 

''{not figured this bit of the code out yet}

 


Next
    End If

EndMacro:

   Next XX

 

 

 

 

Hi, 

QQ and ZZ are only variable for the "FOR NEXT" loop, are only simple variable you can set NNN, or TTT or P or Q or any other letter or word that  can be used as Variable it's the same.

Concerning the LAYER seems the blocks it's placed to only one layer also for next layout MyLay means MY LAYOUT again a simple mnemonic variable.

 

'[attribute 2 to change to value in N20] -> What do you mean ? N20 as "N20" or Excel cell N20 ?

If Excel cell you can wrote attributelist(2).TextString =RANGE("N20").value 'please add before Range sentence, in case, Workbooks(number or name).Sheets(number or name).

 

''[attribute 3 to change to value in N22]

 

attributelist(3).TextString =RANGE("N22").value '

 

''[attribute 5 to change to value to current date]

attributelist(5).TextString = Date ' If you need some particularly date format please manipulate with format function, on the opposite Date return "04/02/20" (European format).

 

''[attribute 6, first 5 characters to change to value in N18]

TempChar=attributelist(6).TextString  '

attributelist(6).TextString = Left (TempChar, 5) & Range("N18").value

 

''[attribute 7, first 5 characters to change to value in N18]

TempChar=attributelist(7).TextString  '

attributelist(7).TextString = Left (TempChar, 5) & Range("N18").value

 

I would like to add that if you already have clear attributes position you have not to do any for next loop for print or store the Array Variable AttributeList, it's already assigned whenever you catch the block with own attributes.

 

Good luck

 

Edited by PeterPan9720

Share this post


Link to post
Share on other sites
barakar42

Thanks for that peter,

 

I've got the needed attributes to change correctly now.

 

The only thing that it's not doing is changing all of the title blocks on all of the layouts and i'm unsure why. It changes the current one only

 

This is the code im using now

 

------------------------------------------------------------------------------------------

 

Sub RENAME_BORDER()

Dim client As String
Dim location As String
Dim acadApp As Object
Dim acadDoc As Object
Dim MyMag As Double


client = Sheets(1).Range("N" & 20).Value
location = Sheets(1).Range("N" & 22).Value
Bname = "TITLE BLOCK"
    On Error Resume Next

 'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument
   If acadApp Is Nothing Then
       Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
   End If
        acadApp.Visible = True
        
    
    Set NewoBlock = acadDoc.ActiveLayout.Block
        For iCount = 0 To NewoBlock.Count - 1
            Set oEnt = NewoBlock.Item(iCount)
                If TypeOf oEnt Is AcadBlockReference Then
                    Set NewoblkRef = oEnt
                        If UCase(NewoblkRef.Name) = UCase(Bname) Then
                           If NewoblkRef.HasAttributes = True Then
                                attributelist = NewoblkRef.GetAttributes
                                    
   
            
           
                              
                                Exit For
                           Else
                                bCount = bCount + 1
                           End If
                
            End If
        End If
    Next iCount
    
    If IsEmpty(attributelist) Then
    GoTo EndMacro
    Else
For QQ = LBound(attributelist) To UBound(attributelist)
    attributelist(2).TextString = Range("N20").Value
    attributelist(3).TextString = Range("N22").Value
    attributelist(5).TextString = Date
        TempChar = attributelist(6).TextString
    attributelist(6).TextString = Range("N18").Value & Right(TempChar, 6)
        TempChar = attributelist(7).TextString '
    attributelist(7).TextString = Range("N18").Value & Right(TempChar, 6)
        
Next
    End If

EndMacro:
End Sub
 

Share this post


Link to post
Share on other sites
PeterPan9720
16 minutes ago, barakar42 said:

Thanks for that peter,

 

I've got the needed attributes to change correctly now.

 

The only thing that it's not doing is changing all of the title blocks on all of the layouts and i'm unsure why. It changes the current one only

 

This is the code im using now

 

------------------------------------------------------------------------------------------

 

Sub RENAME_BORDER()

Dim client As String
Dim location As String
Dim acadApp As Object
Dim acadDoc As Object
Dim MyMag As Double


client = Sheets(1).Range("N" & 20).Value
location = Sheets(1).Range("N" & 22).Value
Bname = "TITLE BLOCK"
    On Error Resume Next

 'Check if AutoCAD application is open. If is not opened create a new instance and make it visible.
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument
   If acadApp Is Nothing Then
       Set acadApp = CreateObject("AutoCAD.Application")
        acadApp.Visible = True
   End If
        acadApp.Visible = True
        
    
    Set NewoBlock = acadDoc.ActiveLayout.Block
        For iCount = 0 To NewoBlock.Count - 1
            Set oEnt = NewoBlock.Item(iCount)
                If TypeOf oEnt Is AcadBlockReference Then
                    Set NewoblkRef = oEnt
                        If UCase(NewoblkRef.Name) = UCase(Bname) Then
                           If NewoblkRef.HasAttributes = True Then
                                attributelist = NewoblkRef.GetAttributes
                                    
   
            
           
                              
                                Exit For
                           Else
                                bCount = bCount + 1
                           End If
                
            End If
        End If
    Next iCount
    
    If IsEmpty(attributelist) Then
    GoTo EndMacro
    Else
For QQ = LBound(attributelist) To UBound(attributelist) 'DELETE
    attributelist(2).TextString = Range("N20").Value
    attributelist(3).TextString = Range("N22").Value
    attributelist(5).TextString = Date
        TempChar = attributelist(6).TextString
    attributelist(6).TextString = Range("N18").Value & Right(TempChar, 6)
        TempChar = attributelist(7).TextString '
    attributelist(7).TextString = Range("N18").Value & Right(TempChar, 6)
        
Next 'DELETE
    End If

EndMacro:

acadDoc.Regen acAllViewports 'ADD

 

End Sub

 

You should only regen the drawing please add code as row before End Sub for automatic drawing regeneration, and delete row indicated with "DELETE" you don't need to make a loop if you already know the attribute position. Now should work properly.

Once defined a block in the drawing this will be the same (if used) in all layouts.

Edited by PeterPan9720

Share this post


Link to post
Share on other sites
barakar42

Hi Peter,

 

Even after modifying the code slightly, it's still only updating one layout, however, i've now modified some code in another part of the  program to call the RENAME_BORDER() sub and it'll only run that on the specific tabs that we need.

 

Your help has been amazing Peter !!!!!!

Share this post


Link to post
Share on other sites
PeterPan9720
On 2/5/2020 at 11:32 AM, barakar42 said:

Hi Peter,

 

Even after modifying the code slightly, it's still only updating one layout, however, i've now modified some code in another part of the  program to call the RENAME_BORDER() sub and it'll only run that on the specific tabs that we need.

 

Your help has been amazing Peter !!!!!!

Hi, 

I'm very stupid !! It's right ! I gave you wrong indications and suggestions sorry for that.

 

Below just a little explanation of using blocks with attributes, sorry but it's necessary to understand because it's not working properly.

 

The scope to have a block with attributes it's related to use the same block with different information inside, in this case you are using block with attributes  for a company frame or diagram frame with drawing information setting, but try to think to a process flow diagram, you have for example same object "valve" that could have different properties (attributes value) for example size, or any other useful information. In case of valve for example you will not insert hundred blocks for each valve, you will insert the same block with "valve" shape, with different attributes value of attributes name defined during the block creation, for example size, or number of item, tag and so on. The scope of this will be for automatic Bill of Material creation. You can have excel or database exchange data of attributes value (more or less the opposite of that you are doing) of all block inside your drawing, or any kind of drawing block contents information required.

 

So coming back to your issue, and with foot on the earth:

  • First of all, all attributes required in your block will be the same for all layout (REMEMBER the difference between  TAGSTRING that is the name of attribute, and TEXTSTRING which is the value of the attribute indicated with related name). So if you insert your block in the layout 1, 2, or 3 the amount and name of attributes are inside the block structure and will no change, what will be change are the attributes value required in the same time when you required to insert the block in your drawing, that could be different for layout 1, 2 or 3 (for example sheet number or a specific sheet content description).

In order to solve this you have two solutions:

  1. Automatic
  2. Manual

it's depend from what are yours requirements:

May we start from 2nd option more easy  😀 

You have to switch manually the selected layout where "TITLE BLOCK" block it has been inserted, run the procedure for each layout, and in case change the attributes value for such layout after the end of procedure, by hand with a double click on block object.

As Alternative you can use windows Clipboard:

  • select the first "TITLE BLOCK" object in the first layout, Right Click on mouse you should have a menu with clipboard option, click on copy with base point, as base point you can insert by hand 0,0 when required a coordinates, switch on second layout, delete the actual empty "TITLE BLOCK", again right click, again clipboard, and use Paste to Original Coordinates. Repeat the procedure for each layout and in this way you will have also all the source attributes contents in the 2nd, 3rd and how many layout you will have in your drawing.

The first option it's more complicated I already showed you the code, but here below again reported:

'
' here variable declartion as the same procedure
'
MyLay = acadDoc.Layouts.Count 
For XX = 1 To MyLay
    acadDoc.ActiveLayout = acadDoc.Layouts.Item(XX)
'
' here code of procedure to catch the block and modify attributes
'
Next XX
End Sub

it's consist of inserting an automatic active layout switch, catch the "TITLE BLOCK" block (with the same procedure used until now), modify the attributes indicated in the procedure, and you will have exactly the same attributes.

 

I hope now it should work with both options.

Regards 👌

 

Edited by PeterPan9720

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...