Custom Drawing Properties Userform
I assume you are using 64-bit AutoCAD and 2014 or later (thus 64-bit VBA). The reason I metion this is because 64-bit VBA has very limited UI component support. When you want to have a good UI to control what user can input data for the custom properties, you may want to have best UI experience built with your progarm. For example, if you want a property value to be a valid Date/Time value, you may want to use a DateTimePicker control, which is not available for 64-bit VBA (well, at leat is not easily/directly available in AutiCAD VBA).
With taht said, and if you only need to know/learn how to trigger a UI for getting user input, here is code samples (and video clip showing how the code works):
First, a class module: clsDwgProp
Option Explicit Public propName As String Public propValue As String
Then, a class module: clsDwgProps
Option Explicit
Public DwgProperties As Collection
Public Property Get CustomPropertyCount() As Integer
CustomPropertyCount = DwgProperties.Count()
End Property
Public Sub GetDwgProperties(dwg As AcadDocument)
Dim i As Long
Dim prop As clsDwgProp
Dim key As String
Dim val As String
For i = 0 To dwg.SummaryInfo.NumCustomInfo() - 1
dwg.SummaryInfo.GetCustomByIndex i, key, val
Set prop = New clsDwgProp
prop.propName = key
prop.propValue = val
DwgProperties.Add prop, prop.propName
Next
End Sub
Public Function SetProperty(propName As String, propValue As String) As Boolean
Dim prop As clsDwgProp
Dim found As Boolean
If IsValidValue(propName, propValue) Then
For Each prop In DwgProperties
If UCase(prop.propName) = UCase(propName) Then
found = True
prop.propValue = propValue
Exit For
End If
Next
If Not found Then
Set prop = New clsDwgProp
prop.propName = propName
prop.propValue = propValue
DwgProperties.Add prop, prop.propName
End If
SetProperty = True
Else
SetProperty = False
End If
End Function
Public Sub SaveDwgProperties(dwg As AcadDocument)
Dim prop As clsDwgProp
Dim i As Integer
Dim key As String
Dim val As String
Dim found As Boolean
For Each prop In DwgProperties
found = False
For i = 0 To dwg.SummaryInfo.NumCustomInfo - 1
dwg.SummaryInfo.GetCustomByIndex i, key, val
If UCase(key) = UCase(prop.propName) Then
dwg.SummaryInfo.SetCustomByKey prop.propName, prop.propValue
found = True
Exit For
End If
Next
If Not found Then
dwg.SummaryInfo.AddCustomInfo prop.propName, prop.propValue
End If
Next
End Sub
Private Function IsValidValue(propName As String, propVal As String) As Boolean
'' Do property value validation here
IsValidValue = True
End Function
Private Sub Class_Initialize()
Set DwgProperties = New Collection
End Sub
As you can see these 2 classes are resposible to retrieve/add/update drawing custom properties (for simplicity, I omiited deleting property...)
Then I used a form to show existing properties, where user can update property values, and add new property. Again, for simplicity, I only show the first 2 properties; and only allows to add one property at a time; and do not presnt a way to delete properties. Also, because of the 64-bit VBA UI limitation, I useed simple lable and textbox. It would better to use a DataGridView, as the AutoCAD built-in UI (with command "DWGPROPS"). But the for would be enough to show the workflow: how to get user input, what to do if user click "OK", or "Cancel"...
Here is the code for the UserForm (you can see how the form looks in the video):
Option Explicit
Private mOked As Boolean
Private mProps As clsDwgProps
Public Property Get isOked() As Boolean
isOked = mOked
End Property
Public Sub SetForm(props As clsDwgProps)
Set mProps = props
Dim i As Integer
Dim prop As clsDwgProp
Dim lbl As Label
Dim txt As TextBox
For Each prop In mProps.DwgProperties
i = i + 1
If i > 2 Then Exit Sub '' For the sake of simplicity, only show 2 properties
Set lbl = GetLabel(i)
Set txt = GetTextBox(i)
lbl.Caption = prop.propName
txt.Value = prop.propValue
Next
End Sub
Private Function GetLabel(index As Integer) As Label
Dim name As String
name = "lbl" & index
Set GetLabel = FindControl(name)
End Function
Private Function GetTextBox(index As Integer) As TextBox
Dim name As String
name = "txt" & index
Set GetTextBox = FindControl(name)
End Function
Private Function FindControl(name As String) As Control
Dim ctl As Control
Dim foundCtl As Control
Set foundCtl = Nothing
For Each ctl In Me.frameEdit.Controls
If ctl.name = name Then
Set foundCtl = ctl
Exit For
End If
Next
Set FindControl = ctl
End Function
Private Function GetUserInputs() As Boolean
Dim i As Integer
Dim prop As clsDwgProp
Dim propName As String
Dim propValue As String
Dim lbl As Label
Dim txt As TextBox
For i = 1 To 2
Set lbl = GetLabel(i)
Set txt = GetTextBox(i)
propName = lbl.Caption
propValue = txt.Value
If Not mProps.SetProperty(propName, propValue) Then
GetUserInputs = False
Exit Function
End If
Next
If Trim(txtName.Value) <> "" And Trim(txtValue.Value) <> "" Then
If Not mProps.SetProperty(Trim(txtName.Value), Trim(txtValue)) Then
GetUserInputs = False
Exit Function
End If
End If
GetUserInputs = True
End Function
Private Sub cmdCancel_Click()
mOked = False
Me.hide
End Sub
Private Sub cmdOK_Click()
If Not GetUserInputs() Then
Exit Sub
End If
mOked = True
Me.hide
End Sub
Finally, here is the macro module that actually run the program:
Option Explicit
Public Sub DoDwgPropers()
Dim props As clsDwgProps
Set props = New clsDwgProps
props.GetDwgProperties ThisDrawing
MsgBox props.CustomPropertyCount & " custom properties found!"
Dim dlg As dlgProps
Set dlg = New dlgProps
Dim isOked As Boolean
dlg.SetForm props
dlg.show
isOked = dlg.isOked
Unload dlg
If isOked Then
props.SaveDwgProperties ThisDrawing
End If
End Sub
HTH.
Did you paste all the code to the same module? or did you create the specified class modules and put in their respective code?
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
The code goes in 4 different modules. Note the instructions just above each code window. The first two are class modules, the 3rd goes in the form's code module and the last goes in a standard module.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
When you created the two class modules, did you right click on the Modules node, select Insert>Class Module? There are two types of modules, regular modules and class modules, which can be instantiated.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Please state what your issues are. Did you create a form or just paste the code?
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.