Attribute VB_Name = "DeleteCivilAnno" ' VBA Macro to delete selected Annotation groups from Drawing Models - by M. Shamoun (18/07/21) Sub selectAnno() Dim oScanEnumerator As ElementEnumerator, oScanEnumerator0 As ElementEnumerator, ph As PropertyHandler Dim oGroupName As String, ph0 As PropertyHandler, oElement As Element, oSelected As Element, oModel As ModelReference If ActiveModelReference.Type = msdModelTypeDrawing Then If ActiveModelReference.AnyElementsSelected = False Then CadInputQueue.SendCommand "beep" ShowMessage "ERROR - No elements selected", , msdMessageCenterPriorityError, True GoTo finish Else Set oScanEnumerator0 = ActiveModelReference.GetSelectedElements oScanEnumerator0.MoveNext Set oSelected = oScanEnumerator0.Current If oSelected.ModelReference.IsAttachment = False And oSelected.ModelReference.Name = ActiveModelReference.Name Then Set ph0 = CreatePropertyHandler(oSelected) If ph0.SelectByAccessString("Groups[0].Description") = True Then oSearch = InStr(ph0.GetDisplayString, "\") oGroupName = Left(ph0.GetDisplayString, oSearch) If ph0.GetDisplayString = "" Then CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Selected element is not Civil Annotation", , msdMessageCenterPriorityError, True GoTo finish End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Selected element is not Civil Annotation", , msdMessageCenterPriorityError, True GoTo finish End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Only elements in active model can be used for this tool", , msdMessageCenterPriorityError, True GoTo finish End If Set oScanEnumerator = ActiveModelReference.Scan Do While oScanEnumerator.MoveNext Set oElement = oScanEnumerator.Current countTot = countTot + 1 Set ph = CreatePropertyHandler(oElement) If oElement.IsGraphical = True And oElement.ModelReference.Name = ActiveModelReference.Name And oElement.ModelReference.IsAttachment = False Then If ph.SelectByAccessString("Groups[0].Description") = True Then oSearch = InStr(ph.GetDisplayString, "\") oNew = Left(ph.GetDisplayString, oSearch) If oNew = oGroupName Then ActiveModelReference.SelectElement oElement count = count + 1 End If End If End If Loop CadInputQueue.SendCommand "beep" If count > 0 Then ShowMessage CStr(count) + " element(s) selected in active model", , msdMessageCenterPriorityInfo Else ShowMessage "No associated Civil Annotation found in active model", , msdMessageCenterPriorityWarning, True End If End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Tool can only be run in a Drawing model", , msdMessageCenterPriorityError, True End If GoTo finish skip: finish: CommandState.StartDefaultCommand Exit Sub End Sub Sub deleteAnno() Dim oScanEnumerator As ElementEnumerator, oScanEnumerator0 As ElementEnumerator, ph As PropertyHandler Dim oGroupName As String, ph0 As PropertyHandler, oElement As Element, oSelected As Element, oModel As ModelReference If ActiveModelReference.Type = msdModelTypeDrawing Then If ActiveModelReference.AnyElementsSelected = False Then CadInputQueue.SendCommand "beep" ShowMessage "ERROR - No elements selected", , msdMessageCenterPriorityError, True GoTo finish Else Set oScanEnumerator0 = ActiveModelReference.GetSelectedElements oScanEnumerator0.MoveNext Set oSelected = oScanEnumerator0.Current If oSelected.ModelReference.IsAttachment = False And oSelected.ModelReference.Name = ActiveModelReference.Name Then Set ph0 = CreatePropertyHandler(oSelected) If ph0.SelectByAccessString("Groups[0].Description") = True Then oSearch = InStr(ph0.GetDisplayString, "\") oGroupName = Left(ph0.GetDisplayString, oSearch) If ph0.GetDisplayString = "" Then CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Selected element is not Civil Annotation", , msdMessageCenterPriorityError, True GoTo finish End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Selected element is not Civil Annotation", , msdMessageCenterPriorityError, True GoTo finish End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Only elements in active model can be used for this tool", , msdMessageCenterPriorityError, True GoTo finish End If Set oScanEnumerator = ActiveModelReference.Scan Do While oScanEnumerator.MoveNext Set oElement = oScanEnumerator.Current countTot = countTot + 1 Set ph = CreatePropertyHandler(oElement) If oElement.IsGraphical = True And oElement.ModelReference.Name = ActiveModelReference.Name And oElement.ModelReference.IsAttachment = False Then If ph.SelectByAccessString("Groups[0].Description") = True Then oSearch = InStr(ph.GetDisplayString, "\") oNew = Left(ph.GetDisplayString, oSearch) If oNew = oGroupName Then ActiveModelReference.RemoveElement oElement count = count + 1 End If End If End If Loop CadInputQueue.SendCommand "beep" If count > 0 Then ShowMessage CStr(count) + " annotation element(s) deleted from active Drawing model." & vbNewLine & vbNewLine + "Removed Annotation Group: " + vbNewLine + Left(ph0.GetDisplayString, oSearch - 1), , msdMessageCenterPriorityInfo, True Else ShowMessage "No associated Civil Annotation found in any Drawing models", , msdMessageCenterPriorityWarning, True End If End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Tool can only be run in a Drawing model", , msdMessageCenterPriorityError, True End If GoTo finish skip: finish: CommandState.StartDefaultCommand Exit Sub End Sub Sub deleteAnnoAll() Dim oScanEnumerator As ElementEnumerator, oScanEnumerator0 As ElementEnumerator, ph As PropertyHandler Dim oGroupName As String, ph0 As PropertyHandler, oElement As Element, oSelected As Element, oModel As ModelReference If ActiveModelReference.Type = msdModelTypeDrawing Then For Each oModel In ActiveDesignFile.Models If oModel.Type = msdModelTypeDrawing Then countDrawings = countDrawings + 1 End If Next If ActiveModelReference.AnyElementsSelected = False Then CadInputQueue.SendCommand "beep" ShowMessage "ERROR - No elements selected", , msdMessageCenterPriorityError, True GoTo finish Else Set oScanEnumerator0 = ActiveModelReference.GetSelectedElements oScanEnumerator0.MoveNext Set oSelected = oScanEnumerator0.Current If oSelected.ModelReference.IsAttachment = False And oSelected.ModelReference.Name = ActiveModelReference.Name Then Set ph0 = CreatePropertyHandler(oSelected) If ph0.SelectByAccessString("Groups[0].Description") = True Then oSearch = InStr(ph0.GetDisplayString, "\") oGroupName = Left(ph0.GetDisplayString, oSearch) If ph0.GetDisplayString = "" Then CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Selected element is not Civil Annotation", , msdMessageCenterPriorityError, True GoTo finish End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Selected element is not Civil Annotation", , msdMessageCenterPriorityError, True GoTo finish End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Only elements in active model can be used for this tool", , msdMessageCenterPriorityError, True GoTo finish End If ' Save current model name currMod = ActiveModelReference.Name ' Cycle through models and delete matching annotation group elements For Each oModel In ActiveDesignFile.Models If oModel.Type = msdModelTypeDrawing Then totmodels = totmodels + 1 count1 = 0 Set oScanEnumerator = oModel.Scan oRun = 1 oModel.Activate ShowTempMessage msdStatusBarAreaMiddle, "Processing Drawing model " + CStr(totmodels) + " of " + CStr(countDrawings) + "..." Do While oScanEnumerator.MoveNext Set oElement = oScanEnumerator.Current countTot = countTot + 1 If oElement.IsGraphical = True And oElement.ModelReference.Name = ActiveModelReference.Name And oElement.ModelReference.IsAttachment = False Then Set ph = CreatePropertyHandler(oElement) If ph.SelectByAccessString("Groups[0].Description") = True Then oSearch = "" oSearch = InStr(ph.GetDisplayString, "\") oNew = Left(ph.GetDisplayString, oSearch) If StrComp(oNew, oGroupName, vbBinaryCompare) = 0 Then oModel.RemoveElement oElement count = count + 1 count1 = count + 1 End If End If End If Loop If count1 > 0 Then countMod = countMod + 1 End If End If Set oElement = Nothing Set oModel = Nothing Set oScanEnumerator = Nothing Next ' Return to original model ActiveDesignFile.Models(currMod).Activate CadInputQueue.SendCommand "beep" If count > 0 Then ShowMessage CStr(count) + " total annotation element(s) deleted from " + CStr(countMod) + " Drawing models." & vbNewLine & vbNewLine + "Removed Annotation Group: " + vbNewLine + Left(ph0.GetDisplayString, oSearch - 1), , msdMessageCenterPriorityInfo, True Else ShowMessage "No associated Civil Annotation found in any Drawing models", , msdMessageCenterPriorityWarning, True End If End If Else CadInputQueue.SendCommand "beep" ShowMessage "ERROR - Tool can only be run in a Drawing model", , msdMessageCenterPriorityError, True End If GoTo finish skip: finish: CommandState.StartDefaultCommand Exit Sub End Sub