PeterPan9720 Posted January 24, 2020 Posted January 24, 2020 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! Quote
PeterPan9720 Posted January 24, 2020 Posted January 24, 2020 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. Quote
PeterPan9720 Posted January 25, 2020 Posted January 25, 2020 (edited) 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. '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 January 25, 2020 by PeterPan9720 Quote
PeterPan9720 Posted January 26, 2020 Posted January 26, 2020 (edited) 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 January 26, 2020 by PeterPan9720 Quote
PeterPan9720 Posted January 27, 2020 Posted January 27, 2020 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. Quote
barakar42 Posted January 29, 2020 Author Posted January 29, 2020 Hi Peter, Thanks for that. I'll give it a go when I get a chance at work Quote
barakar42 Posted February 3, 2020 Author Posted February 3, 2020 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 Quote
PeterPan9720 Posted February 3, 2020 Posted February 3, 2020 (edited) 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 February 3, 2020 by PeterPan9720 Quote
PeterPan9720 Posted February 3, 2020 Posted February 3, 2020 (edited) 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 February 3, 2020 by PeterPan9720 Quote
barakar42 Posted February 4, 2020 Author Posted February 4, 2020 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 Quote
PeterPan9720 Posted February 4, 2020 Posted February 4, 2020 (edited) 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 February 4, 2020 by PeterPan9720 Quote
barakar42 Posted February 4, 2020 Author Posted February 4, 2020 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 Quote
PeterPan9720 Posted February 4, 2020 Posted February 4, 2020 (edited) 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 ElseFor 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 February 4, 2020 by PeterPan9720 Quote
barakar42 Posted February 5, 2020 Author Posted February 5, 2020 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 !!!!!! Quote
PeterPan9720 Posted February 5, 2020 Posted February 5, 2020 (edited) 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: Automatic 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 February 6, 2020 by PeterPan9720 Quote
Recommended Posts
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.