Sub Main 'make sure we are working with a drawing...if not let user know, and exit the rule If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then MsgBox("Esta macro solo puede ser utilizada en un plano.", vbCritical, "") Exit Sub End If Dim oDDoc As DrawingDocument = ThisDoc.Document Dim oACBDs As AutoCADBlockDefinitions = oDDoc.AutoCADBlockDefinitions If oACBDs.Count = 0 Then Exit Sub 'none found in drawing, so exit the rule 'this next variable will be used to store the block definition we are trying to find, when found Dim oTargetACBD As AutoCADBlockDefinition = Nothing 'store the two possible names of the block definition we are looking for Dim PossibleBlockDefNames() As String = {"SH_CAR_S", "Copia de SH_CAR_S" } 'loop through the AutoCADBlockDefinitions, to find the one we are after For Each oACBD As AutoCADBlockDefinition In oACBDs 'if the block definition is not being referenced (no placed blocks for it), try to delete it 'if an instance of it has not been placed, there will not be any values to get If oACBD.IsReferenced = False Then Try : oACBD.Delete : Catch : End Try 'loop through the two possible names for the block definition For Each BlockDefName In PossibleBlockDefNames If oACBD.Name = BlockDefName Then oTargetACBD = oACBD Exit For 'exits this inner loop End If Next 'BlockDefName If oTargetACBD IsNot Nothing Then Exit For 'exit outer loop if target already found Next 'oACBD If IsNothing(oTargetACBD) Then Exit Sub 'the definition was not found, so exit rule 'we must prepare the variables ahead of time, then this method fills in their values Dim oTags() As String = {} Dim oPrompts() As String = {} oTargetACBD.GetPromptTags(oTags, oPrompts) If oPrompts.Length = 0 Then Exit Sub 'the block definition does not have any prompts, so exit rule 'these next two lines are simply for research & feedback, you can comment them out if you want 'oTagx = InputListBox("", oTags, "", oTargetACBD.Name & " Tags", "List Of Tags") 'oPromptx = InputListBox("", oPrompts, "", oTargetACBD.Name & " Prompts", "List Of Prompts") 'get a reference to the drawing's 'Custom' iProperty set, for use later within the loop Dim oCProps As Inventor.PropertySet = oDDoc.PropertySets.Item(4) 'now loop through the sheets to find placed blocks referencing the definition Dim oSheets As Inventor.Sheets = oDDoc.Sheets For Each oSheet As Inventor.Sheet In oSheets Dim oACBs As AutoCADBlocks = oSheet.AutoCADBlocks If oACBs.Count = 0 Then Continue For 'skip to next sheet if no blocks on this sheet For Each oABC As AutoCADBlock In oACBs 'if the definition this block is referencing is not our 'target' one, then skip to next block If oABC.Definition IsNot oTargetACBD Then Continue For 'again, we must prepare the variables first, then this method fills in their values Dim oPromptTags() As String = {} Dim oValues() As String = {} oABC.GetPromptTextValues(oPromptTags, oValues) If oPromptTags.Length = 0 Then Continue For 'there were no prompts, so skip to next For i As Integer = 0 To UBound(oPromptTags) Dim sPromptTag As String = oPromptTags(i) Dim sValue As String = oValues(i) Dim bEmptyValue As Boolean = String.IsNullOrEmpty(sValue) Dim bCanBeConvertedToDate As Boolean = IsDate(sValue) Dim oDate As Date = Date.MinValue If bCanBeConvertedToDate = True Then Try : oDate = Convert.ToDateTime(sValue, System.Globalization.CultureInfo.CurrentCulture) : Catch : End Try End If Dim oCProp As Inventor.Property = Nothing Select Case sPromptTag Case "SH_AFFAI" Try : oCProp = oCProps.Item("NUMERO INSTALACION") Catch : oCProp = oCProps.Add(sValue, "NUMERO INSTALACION") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_PARTI" Try : oCProp = oCProps.Item("CODIGO DE PARTICION") Catch : oCProp = oCProps.Add(sValue, "CODIGO DE PARTICION") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_MODUL" Try : oCProp = oCProps.Item("NUMERO MODULO") Catch : oCProp = oCProps.Add(sValue, "NUMERO MODULO") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_TECHN" Try : oCProp = oCProps.Item("CODIGO TECNICO") Catch : oCProp = oCProps.Add(sValue, "CODIGO TECNICO") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_T_D_D" Try : oCProp = oCProps.Item("TIPO DE PLANO") Catch : oCProp = oCProps.Add(sValue, "TIPO DE PLANO") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_N_O" Try : oCProp = oCProps.Item("NUMERO PLANO") Catch : oCProp = oCProps.Add(sValue, "NUMERO PLANO") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_CREVI" Try : oCProp = oCProps.Item("NUMERO REVISION") Catch : oCProp = oCProps.Add(sValue, "NUMERO REVISION") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_N_D_C" Try : oCProp = oCProps.Item("NOMBRE DE CLIENTE") Catch : oCProp = oCProps.Add(sValue, "NOMBRE DE CLIENTE") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_TYP_I" Try : oCProp = oCProps.Item("TIPO DE INSTALACION") Catch : oCProp = oCProps.Add(sValue, "TIPO DE INSTALACION") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_LIB_E" Try : oCProp = oCProps.Item("PRIMERA LINEA") Catch : oCProp = oCProps.Add(sValue, "PRIMERA LINEA") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_LIB_P" Try : oCProp = oCProps.Item("SEGUNDA LINEA") Catch : oCProp = oCProps.Add(sValue, "SEGUNDA LINEA") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_LIB_D" Try : oCProp = oCProps.Item("TERCERA LINEA") Catch : oCProp = oCProps.Add(sValue, "TERCERA LINEA") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_DESS" Try : oCProp = oCProps.Item("DISEÑADOR") Catch : oCProp = oCProps.Add(sValue, "DISEÑADOR") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_DATE_DESS" Try : oCProp = oCProps.Item("FECHA CREACION") : Catch : End Try If oCProp Is Nothing Then Try : oCProp = oCProps.Add(oDate, "FECHA CREACION") : Catch : End Try Else If oCProp.Value <> oDate Then Try : oCProp.Value = oDate : Catch : End Try End If Case "SH_VERIF" Try : oCProp = oCProps.Item("VERIFICADOR") Catch : oCProp = oCProps.Add(sValue, "VERIFICADOR") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_TREVI" Try : oCProp = oCProps.Item("REVISION") Catch : oCProp = oCProps.Add(sValue, "REVISION") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_TYP_MODIF" Try : oCProp = oCProps.Item("MOTIVO REVISION") Catch : oCProp = oCProps.Add(sValue, "MOTIVO REVISION") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_NAME_MODIFIER" Try : oCProp = oCProps.Item("NOMBRE MODIFICADOR") Catch : oCProp = oCProps.Add(sValue, "NOMBRE MODIFICADOR") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try Case "SH_DATE_MODIF" Try : oCProp = oCProps.Item("FECHA REVISION") : Catch : End Try If oCProp Is Nothing Then Try : oCProp = oCProps.Add(oDate, "FECHA REVISION") : Catch : End Try Else If oCProp.Value <> oDate Then Try : oCProp.Value = oDate : Catch : End Try End If Case "SH_NAME_CHECK" Try : oCProp = oCProps.Item("VERIFICADOR REVISION") Catch : oCProp = oCProps.Add(sValue, "VERIFICADOR REVISION") : End Try If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try '<<<< repeat pattern of code for the rest of the prompts, values, & custom iProperties >>>> End Select Next 'i 'now try to delete this placed AutoCADBlock object from the sheet Try : oABC.Delete : Catch : End Try Next 'oABC Next 'oSheet 'now that we have attempted to copy the needed data out, 'and have attempted to delete all of the placed blocks that reference the definition, 'we can now try to delete the block definition itself Try : oTargetACBD.Delete : Catch : End Try 'you may need to update the drawing now If oDDoc.RequiresUpdate Then oDDoc.Update2(True) 'you may want to save the drawing now, but maybe not, so I left this commented out 'If oDDoc.Dirty Then oDDoc.Save2(False) End Sub