metal_pro Posted April 16, 2010 Share Posted April 16, 2010 I would like to use VBA to select a block and have the attribute values populated on a VBA form. Then after Editing/changing the values on the form have the previously selected block updated with the new values. I have been able to used some modified code from bsamc2000 in another post to read the block's attribute values and populate a form but how would I update the block with all the edited values from the form? Sub Change_it() Dim obj As AcadBlockReference Dim inspt As Variant ParentSymbolForm.hide ThisDrawing.Utility.GetEntity obj, inspt, "Select object:" ' Checks if you selected a block. If obj.ObjectName = "AcDbBlockReference" Then ' Check for attributes. If obj.HasAttributes Then Dim AttList As Variant ' Build a list of attributes for the current block. AttList = obj.GetAttributes ' Cycle throught the list of attributes. For I = LBound(AttList) To UBound(AttList) ' Check for the correct attribute tag. If AttList(I).TagString = "TAG1" Then ParentSymbolForm.ComponetTag.Text = AttList(I).TextString End If If AttList(I).TagString = "DESC1" Then ParentSymbolForm.TextBoxDesc1.Text = AttList(I).TextString End If If AttList(I).TagString = "DESC2" Then ParentSymbolForm.TextBoxDesc2.Text = AttList(I).TextString End If If AttList(I).TagString = "TERM01" Then ParentSymbolForm.TextBoxPin1.Text = AttList(I).TextString End If If AttList(I).TagString = "POS1" Then ParentSymbolForm.TextBoxSwPos1.Text = AttList(I).TextString End If Next End If ParentSymbolForm.Show Else MsgBox "You did not select a block." End If End Sub Quote Link to comment Share on other sites More sharing options...
fixo Posted April 18, 2010 Share Posted April 18, 2010 Try this (see 'Select Case' statement in VBA Help) Option Explicit Dim oBlkRef As AcadBlockReference Sub Change_it() Dim inspt As Variant Dim oEnt As AcadEntity Dim i ParentSymbolForm.Hide ThisDrawing.Utility.GetEntity oEnt, inspt, "Select object:" ' Checks if you selected a block. If TypeOf oEnt Is AcadBlockReference Then Set oBlkRef = oEnt ' Check for attributes. If oBlkRef.HasAttributes Then Dim AttList As Variant ' Build a list of attributes for the current block. AttList = oBlkRef.GetAttributes ' Cycle throught the list of attributes. For i = LBound(AttList) To UBound(AttList) ' Check for the correct attribute tag. If AttList(i).TagString = "TAG1" Then ParentSymbolForm.ComponetTag.Text = AttList(i).TextString End If If AttList(i).TagString = "DESC1" Then ParentSymbolForm.TextBoxDesc1.Text = AttList(i).TextString End If If AttList(i).TagString = "DESC2" Then ParentSymbolForm.TextBoxDesc2.Text = AttList(i).TextString End If If AttList(i).TagString = "TERM01" Then ParentSymbolForm.TextBoxPin1.Text = AttList(i).TextString End If If AttList(i).TagString = "POS1" Then ParentSymbolForm.TextBoxSwPos1.Text = AttList(i).TextString End If Next End If ParentSymbolForm.Show Else MsgBox "You did not select a block." End If End Sub Private Sub SelectButton_Click() Call Change_it End Sub Private Sub ChangeButton_Click() Me.Hide Dim AttList As Variant Dim i ' Change attributes for the selected block. AttList = oBlkRef.GetAttributes ' Cycle throught the list of attributes. For i = LBound(AttList) To UBound(AttList) ' Check for the correct attribute tag. Select Case AttList(i).TagString Case "TAG1" AttList(i).TextString = ParentSymbolForm.ComponetTag.Text Case "DESC1" AttList(i).TextString = ParentSymbolForm.TextBoxDesc1.Text Case "DESC2" AttList(i).TextString = ParentSymbolForm.TextBoxDesc2.Text Case "TERM01" AttList(i).TextString = ParentSymbolForm.TextBoxPin1.Text Case "POS1" AttList(i).TextString = ParentSymbolForm.TextBoxSwPos1.Text End Select Next End Sub ~'J'~ Quote Link to comment Share on other sites More sharing options...
BIGAL Posted April 19, 2010 Share Posted April 19, 2010 After getting the attributes maybe update them ? attribs(1).TextString = txtx1 attribs(2).TextString = TXTY1 attribs(1).Update attribs(2).Update Just a question why do this ? If you double click a block it comes up with a form all ready allowing you to change any value. _eattedit Quote Link to comment Share on other sites More sharing options...
fixo Posted April 19, 2010 Share Posted April 19, 2010 After getting the attributes maybe update them ? attribs(1).TextString = txtx1 attribs(2).TextString = TXTY1 attribs(1).Update attribs(2).Update Just a question why do this ? If you double click a block it comes up with a form all ready allowing you to change any value. _eattedit IMO 'Update' is optional in this case ~'J'~ Quote Link to comment Share on other sites More sharing options...
metal_pro Posted April 28, 2010 Author Share Posted April 28, 2010 After getting the attributes maybe update them ? attribs(1).TextString = txtx1 attribs(2).TextString = TXTY1 attribs(1).Update attribs(2).Update Just a question why do this ? If you double click a block it comes up with a form all ready allowing you to change any value. _eattedit For editing symbols using a custom form is much better then the standard Attribute Editor. I have attached a preliminary JPG of my form for editing electrical symbols. The Data I will need to change is presented in a much more orderly function and Attributes that do not normally require editing are hidden. Plus I will be able to add auto Tagging functions etc. to this form Quote Link to comment Share on other sites More sharing options...
rickjamieh13 Posted May 10, 2018 Share Posted May 10, 2018 (edited) Hello, Can someone help me with this macro I have for starting a detail template? Everything works fine for this macro, the text updates based on the input info, and the scale changes, but I cannot get the strings to change for the Block Name: "DETAIL LABEL". I also need the Tag: "DETAILNAME" Value: "DETAIL NAME" And the Tag: "FULL" and Value: "FULL" to update as well. see below. 'This program is designed for automating the way details are created. 'There is a template file that is called from this program. It is called '"dwgName" and its value is "C:\Users\holguinr\Documents\DG_Office\CAD\DG_CAD\Custom\Detail Library\DGFS_DET_TEMPLATE.dwg". Make sure 'that the path is correct for this file. Private Sub CreateDetail() Dim StrScale As Variant Dim intSDI As Integer Dim entity As Object Dim sset As AcadSelectionSet Dim msSpace As Object Dim acadDoc As Object Dim acadApp As Object Dim strFileName As String Dim StrScale2 As Variant Set acadApp = GetObject(, "Autocad.Application") If Err Then MsgBox Err.Description Exit Sub End If Set acadDoc = acadApp.ActiveDocument ' Open detail temp drawing Dim dwgName As String dwgName = "C:\Users\holguinr\Documents\DG_Office\CAD\DG_CAD\Custom\Detail Library\DGFS_DET_TEMPLATE.dwg" If Dir(dwgName) <> "" Then If intSDI = 0 Then ThisDrawing.Application.Documents.Open dwgName Else ThisDrawing.Open dwgName End If Else MsgBox "File " & dwgName & " does not exist." Unload Me End If Dim strPath As String strPath = ThisDrawing.Application.Path Debug.Print strPath 'Set the drawing name and path StrDwgName = "S:\ACA 2011 Support\Template\CA_Detail_Template.dwt" ThisDrawing.SendCommand ("Filedia 0 ") 'Uncomment these lines if you want to be able to save the detail 'Check to see if file already exists 'Dim Fsys As New FileSystemObject 'Dim Msg, Style, Title, Help, Ctxt, Response, MyString 'Msg = "File Aready Exists, " & Chr(13) & "Do you wish to Overide?" ' Define message. 'Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons. 'Title = "File Aready Exists" ' Define title. 'strFileName = "R:\ACAD\DETAIL\TEMP\" & txtName.Value & ".dwg" 'If Fsys.FileExists(strFileName) Then ' Display message. 'Response = MsgBox(Msg, Style, Title) 'If Response = vbYes Then ' User chose Yes. ' ThisDrawing.SendCommand ("_saveas 2000 " & strFileName & Chr(13)) 'ThisDrawing.SendCommand ("y ") 'ThisDrawing.SendCommand ("Filedia 1 ") 'Else ' User chose No. 'End 'Unload Me 'End If 'Else 'ThisDrawing.SendCommand ("_saveas 2000 " & strFileName & Chr(13)) 'End If 'Set the scale for the drawing 'This can also be done with a control array If Opt1.value = True Then StrScale = "Aec_Full_CA" StrSc = "FULL" StrScale2 = "1" End If If Opt2.value = True Then StrScale = "Aec_Half_Full_CA" StrSc = "HALF" End If If Opt3.value = True Then StrScale = "Aec_3_CA" StrSc = "3" & Chr(34) & "=1" & Chr(39) & "-0" & Chr(34) StrScale2 = "4" End If If Opt4.value = True Then StrScale = "Aec_1_1-2_CA" StrSc = "1 1/2" & Chr(34) & "=1" & Chr(39) & "-0" & Chr(34) StrScale2 = "8" End If If Opt5.value = True Then StrScale = "Aec_1_CA" StrSc = "1" & Chr(34) & "=1" & Chr(39) & "-0" & Chr(34) StrScale2 = "12" End If If Opt6.value = True Then StrScale = "Aec_3-4_CA" StrSc = "3/4" & Chr(34) & "=1" & Chr(39) & "-0" & Chr(34) StrScale2 = "16" End If If Opt7.value = True Then StrScale = "Aec_1-2_CA" StrSc = "1/2" & Chr(34) & "=1" & Chr(39) & "-0" & Chr(34) StrScale2 = "24" End If If Opt8.value = True Then StrScale = "Aec_3-8_CA" StrSc = "3/8" & Chr(34) & "=1" & Chr(39) & "-0" & Chr(34) StrScale2 = "32" End If If Opt9.value = True Then StrScale = "Aec_1-4_CA" StrSc = "1/4" & Chr(34) & "=1" & Chr(39) & "-0" & Chr(34) StrScale2 = "48" End If If Opt10.value = True Then StrScale = "Aec_1-8_CA" StrSc = "1/8" & Chr(34) & "=1" & Chr(39) & "-0" & Chr(34) StrScale2 = "96" End If Debug.Print StrScale Dim strCommand As String Dim SC As Variant Dim strheight As Double Dim Height As Double Dim limx As Double Dim limy As Double Dim strLimits As String 'set the drawing limits limx = 6.8 * CDbl(StrScale2) limy = (5 + (77 / 128)) * CDbl(StrScale2) strLimits = CStr(limx) & "," & CStr(limy) Debug.Print strLimits 'set the text height strheight = CDbl(StrScale2) Height = 0.09375 * strheight Debug.Print "Height = " & Height 'set the scale value SC = StrScale2 'scale the detail block to the proper scale ThisDrawing.SendCommand ("_scale all 0,0 " & StrScale2 & " ") 'set the dimension scale ThisDrawing.SendCommand ("-dimstyle " & "R" & Chr(13) & StrScale & Chr(13) & " ") 'set the linetype scale ThisDrawing.SendCommand ("Ltscale " & StrScale2 & " ") 'regenerate drawing ThisDrawing.SendCommand ("regen ") 'set the drawing limits ThisDrawing.SendCommand ("limits" & Chr(13) & Chr(13) & strLimits & Chr(13)) 'set the filedia variable to 1 ThisDrawing.SendCommand ("Filedia 1 ") 'set the text style for the drawing ThisDrawing.SendCommand ("TEXTSTYLE" & Chr(13) & "Notes_CA" & Chr(13)) 'set the text height for the drawing ThisDrawing.SendCommand ("TEXTSIZE " & CStr(Height) & " ") Debug.Print StrSc Dim elem As Object Dim found As Boolean Dim txtStr As String Dim txtTemp As String txtStr = "Half" ' Cycle through the entities in the ModelSpace ' and change the text For Each elem In ThisDrawing.ModelSpace With elem If (.EntityName = "AcDbText") Or (.EntityName = "AcDbMText") Then ' Change the height of the text entity '.TextString = "test" '.Update 'found = True 'End If txtTemp = .TextString If txtTemp = "FULL" Then .TextString = StrSc End If If txtTemp = "DETAIL NAME" Then .TextString = txtName End If .Update found = True End If End With Set elem = Nothing Next elem Dim attributeObj As AcadAttribute Dim Tag1 As String Dim value1 As String Tag1 = "DETAILNAME" value1 = "DETAIL NAME" Dim Tag2 As String Dim value2 As String Tag2 = "FULL" value2 = "FULL" For Each elem In ThisDrawing.ModelSpace With elem If (.EntityName = AcadAttribute) Then ' Change the height of the text entity '.TextString = "test" '.Update 'found = True 'End If txtTemp = .TextString If value2 = "FULL" Then .TextString = StrSc End If If value1 = "DETAIL NAME" Then .TextString = txtName End If .Update found = True End If End With Set elem = Nothing Next elem ThisDrawing.Application.ZoomExtents ThisDrawing.Regen acAllViewports Unload Me End Sub Private Sub CmdOk_Click() Call CreateDetail End Sub Private Sub FrmScale_Click() End Sub Private Sub lblName_Click() End Sub Private Sub Opt10_Click() End Sub Private Sub Opt5_Click() End Sub Private Sub Opt6_Click() End Sub Private Sub txtName_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then CmdOk.SetFocus End Sub Private Sub CmdCancel_Click() Unload Me End End Sub Private Sub UserForm_Initialize() Opt1.value = True End Sub New_det.zip DGFS_DET_TEMPLATE.zip Edited May 10, 2018 by SLW210 Code Tags Added Quote Link to comment Share on other sites More sharing options...
SLW210 Posted May 10, 2018 Share Posted May 10, 2018 Please read the Code Posting Guidelines and have your Code to be included in Code Tags.[NOPARSE] Your Code Here[/NOPARSE] = Your Code Here Quote Link to comment Share on other sites More sharing options...
rickjamieh13 Posted May 11, 2018 Share Posted May 11, 2018 I did use the # sign icon and show my Code in the code box. it doesn't change the text and code I am posting. Quote Link to comment Share on other sites More sharing options...
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.