Public Function ACADSelSet(funcObjSelSet As AcadSelectionSet, funcSelectionSetName As String)
Dim objSelCol As AcadSelectionSets
On Error GoTo Err_Control
Set objSelCol = ThisDrawing.SelectionSets
For Each funcObjSelSet In objSelCol
If funcObjSelSet.Name = funcSelectionSetName Then
funcObjSelSet.Clear
funcObjSelSet.Delete
Exit For
End If
Next
Set funcObjSelSet = objSelCol.Add(funcSelectionSetName)
Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
Case -2145386300
MsgBox "ACAD_Functions.ACADSelSet" & vbCrLf & Err.Number & " - " & Err.Description
Case Else
MsgBox "ACAD_Functions.ACADSelSet" & vbCrLf & Err.Number & " - " & Err.Description
'ACADBugReportFiller "ACAD_Functions.ACADSelSet", Err.Number, Err.Description
End Select
End Function
Public Function TagStringEdit( _
strblockname As String, _
strTagName As String, _
Optional strOrigTagValue As String, _
Optional strNewTagValue As String)
Dim objSelSet As AcadSelectionSet
Dim objBlkRef As AcadBlockReference
Dim objAttRef As AcadAttributeReference
Dim varAtts As Variant
Dim varData(1) As Variant
Dim intType(1) As Integer
Dim intAElems As Integer
On Error GoTo Err_Control
ACADSelSet objSelSet, "vbdblkrefset"
intType(0) = 0
varData(0) = "INSERT"
intType(1) = 2
varData(1) = strblockname
objSelSet.Select Mode:=acSelectionSetAll, filtertype:=intType, filterdata:=varData
For Each objBlkRef In objSelSet
If objBlkRef.HasAttributes Then
varAtts = objBlkRef.GetAttributes
For intAElems = LBound(varAtts) To UBound(varAtts)
Set objAttRef = varAtts(intAElems)
If objAttRef.TagString = strTagName Then
strOrigTagValue = objAttRef.TextString
If Len(strNewTagValue) > 0 Then
objAttRef.TextString = strNewTagValue
Exit For
End If
End If
Next intAElems
End If
Next objBlkRef
Exit_Here:
Exit Function
Err_Control:
Select Case Err.Number
Case Else
MsgBox "Blocks.TagStringEdit" & vbCrLf & Err.Number & " - " & Err.Description
End Select
End Function
example of calling it
Private Sub cmdOK_Click()
TagStringEdit "TITLINFO", "TECH", , cboTech.Value
TagStringEdit "TITLINFO", "DFTM", , cboDraftman.Value
TagStringEdit "TITLINFO", "CHKRNAME", , cboCheckedBy.Value
TagStringEdit "TITLINFO", "TECHDATE", , TextBox8
TagStringEdit "TITLINFO", "DFTMDATE", , TextBox8
TagStringEdit "TITLINFO", "CHKRDATE", , TextBox8
TagStringEdit "TITLINFO", "ENGNAME", , cboEng.Value
Unload Me
End Sub
