Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
dypro
in reply to: WCrihfield

Hello @WCrihfield , thankyou for all the hard work.

There seems to be an error, when running the code, I think it's my mistake. 

There are two properties "FECHA CREACION" and "FECHA REVISION" that have to be in "date mode" but, when catching the data from the autocad block they are written as follows "06-08-2022" and that, before getting into the property I am guessing it has to be converted to something like "06/08/2022" . Can it be done?

dypro_0-1685694068980.png

Except for that, and that it doesn't delete the block, it works. I paste my actual rule here with all the lines so you have the full code. EDITED, check the bottom

 

 

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
			'again, these next two lines are simply for research & feedback
			'oPromptTagx = InputListBox("", oPromptTags, "", oABC.Name & " PromptTags", "List Of PromptTags")
			'oValuex = InputListBox("", oValues, "", oABC.Name & " Values", "List Of Values")
			For i As Integer = 0 To UBound(oPromptTags)
				Dim sPromptTag As String = oPromptTags(i)
				Dim sValue As String = oValues(i)
				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 : oCProp = oCProps.Add(sValue, "FECHA CREACION") : End Try
						If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try
					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 : oCProp = oCProps.Add(sValue, "FECHA REVISION") : End Try
						If oCProp.Value <> sValue Then Try : oCProp.Value = sValue : Catch : End Try
					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

 

 

For now I am not saving, but yes, probably I will uncomment the line after testing. Or maybe add a question to the user about saving or not.

BTW: Is there also a way to change the color of the sheet to 100,100,100? 

EDIT: ok, @WCrihfield , I've been working on why it does not work the delete thingy, and I have discovered that it DOES delete the block, but only when there is no error. For some reason, when I delete all date iproperties that already where into the drawing it does work.
I have been testing it, the code creates the date Iproperty as "text" (they should be "date") so, if I delete the Iproperties that already where in the drawing and had the "date" parameter on, It creates the iproperties with the "text" parameter on, it does not show an error, and it deletes the block. So i'm guessing that we just have to modify that properties so they have the "date" thing on, and something that prior to getting the parameter into the iproperty changes every "-" for a "/" ..... im I right?