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

Hi @dypro.  This is a fairly complex scenario, and highly custom, so I did not completely finish the code I created for it, but I got you most of the way there.  There is a point down near the end of the code, where you can see that I have left you a comment to continue the pattern of code that I started, because it needs many very similar blocks of code, one for each possible 'prompt', 'value', & custom iProperty grouping.  I could have created one or more externally referenced Sub/Function type routines to help eliminate some of the repetitiveness, but I decided to keep it as simple as possible for you right now, which usually means keeping it all in one logical piece, and flowing from top to bottom in one long process.  I included several lines of comments, but probably could have included many more comments.  If you still need help with this, feel free to post back here again.

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("A Drawing document must be active for this code to work. Exiting.", 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 'Custum' 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"
						'<<<< 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

If this solved your problem, or answered your question, please click ACCEPT SOLUTION .
Or, if this helped you, please click (LIKE or KUDOS) :thumbs_up:.

Wesley Crihfield

EESignature

(Not an Autodesk Employee)