ilogic to create envelope of a part(s) in an assembly

[Scott.Hallmark]

I am trying to develop a tool that, after opening a STEP file from any CAD vendor and Inventor convert it to an IAM, will allow the user to pick the parts in the assembly that have too much detail and create a simplified envelope (box or cylinder) in place of the selected parts.  I am also doing this in 2022.  I have found a couple of rules here that do some of what I need and I have put them together in the code below.  It does not do the cylinder yet, but the main issue is that when I go to do the shrinkwrap in the code, it does not include the envelopes.  These will be going into an AutoCAD toolset so I need the envelopes to show up as solids and not as assembly features.  Any help would be great.

Sub Main()
Dim oDoc As AssemblyDocument = ThisDoc.Document
CreateBoxEnvelope()
'CreateEnvelope()
CreateBIM(oDoc, False)
End Sub


Public Sub CreateBIM(oDoc As AssemblyDocument, Optional ForcePreviewImage As Boolean = False)
	Dim BaseFileName As String
	BaseFileName = Left(oDoc.FullFileName, Len(oDoc.FullFileName) -4)
	Dim oPartDoc As PartDocument
	oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, , ForcePreviewImage)
	'shrinkwrap definition
	Dim oSWD As ShrinkwrapDefinition
	oSWD = oPartDoc.ComponentDefinition.ReferenceComponents.ShrinkwrapComponents.CreateDefinition(oDoc.FullDocumentName)
	Dim oCol As ObjectCollection
	oCol = ThisApplication.TransientObjects.CreateObjectCollection
	Dim oOccu As ComponentOccurrence
	For Each oOccu In oDoc.ComponentDefinition.Occurrences
		oCol.Add(oOccu)
	Next
	oSWD.AdditionalIncludedOccurrences = oCol

	'Set Shrinkwrap Options
	oSWD.RemoveInternalParts = True
	oSWD.DeriveStyle = kDeriveAsSingleBodyNoSeams
	oSWD.UseColorOverrideFromSourceComponent = True
	oSWD.RemoveHolesStyle = kShrinkwrapRemoveByRange
	oSWD.RemoveHolesDiameterRange = 6
	oSWD.BreakLink = True
	Dim oSWComp As ShrinkwrapComponent
	oSWComp = oPartDoc.ComponentDefinition.ReferenceComponents.ShrinkwrapComponents.Add(oSWD)
	Dim strSubstituteFileName As String
	Dim num = 1
	strSubstituteFileName = BaseFileName & "_Shrinkwrap" & num & ".ipt"

	While IO.File.Exists(strSubstituteFileName)
		Logger.Trace("Shrinkwrap file exists, increasing number")
		num = num + 1
		strSubstituteFileName = BaseFileName & "_Shrinkwrap" & num & ".ipt"
		If num > 50 Then
			Exit While
		End If
	End While
	oPartDoc.SaveAs(strSubstituteFileName, False)

	'Properties
	Dim Description As String
	Dim PartNumber As String
	Dim ComponentType As String
	Dim Manufacturer As String
	Dim Model As String
	Dim URL As String

	'Set properties
	Description = "Skid"
	PartNumber = iProperties.Value("Project", "Part Number")
	Manufacturer = "ENTER MANUFACTURER"
	Model = Right(BaseFileName, 6)
	URL = ""

	'Release reference to Assembly Doc
	oDoc = Nothing

	'Set Component Type
	ComponentType = "23.75.50.17.31" ' Skid
	Dim invPartNoProperty As Object
	Dim invDescProperty As Object
	invPartNoProperty = oPartDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number")
	invDescProperty = oPartDoc.PropertySets.Item("Design Tracking Properties").Item("Description")
	invPartNoProperty.Value = PartNumber
	invDescProperty.Value = Description

	'Get Reference BIM Component
	Dim oBIM As BIMComponent
	oBIM = oPartDoc.ComponentDefinition.BIMComponent

	'Write Component Type Definition
	'If this line isn't run, the Model Properties tickbox will not get ticked and Model Properties will not get exported
	oBIM.ComponentDescription.ComponentType = ComponentType

	'Get reference for writing Identity Data
	Dim oBimOC As BIMComponentPropertySet
	oBimOC = oBIM.ComponentDescription.ComponentPropertySets.Item("Identity Data")

	'Write BIM Identity data
	'This must be set after 'Write Component Type Definition' otherwise this data will get wiped
	Dim BIMDescProp As BIMComponentProperty
	Dim BIMManProp As BIMComponentProperty
	Dim BIMModelProp As BIMComponentProperty
	Dim BIMURLProp As BIMComponentProperty
	BIMDescProp = oBimOC.Item(1)
	BIMDescProp.Value = Description
	BIMManProp = oBimOC.Item(2)
	BIMManProp.Value = Manufacturer
	BIMModelProp = oBimOC.Item(3)
	BIMModelProp.Value = Model
	BIMURLProp = oBimOC.Item(4)
	BIMURLProp.Value = URL

	'Export .adsk file
	Dim BIMExport = oPartDoc.File
	Dim ExportFileName = Left(oPartDoc.FullFileName, Len(oPartDoc.FullFileName) -4)
	ExportFileName = ExportFileName & ".adsk"
	Dim Location = InputBox("Where would you like to Export To/as:" & vbLf & "Note: file name to be included with extension .adsk", "PLANT-BIM", ExportFileName)
	oBIM.ExportBuildingComponent(Location)

	'Close the invisibly opened part document.
	'If this document isn't closed or unreferenced, a retry of the code will fail.
	oPartDoc.Close(False)
	oPartDoc = Nothing
End Sub


Sub CreateBoxEnvelope()

	Dim oSelected As ObjectCollection
	Dim oSelect As Object
	oSelected = ThisApplication.TransientObjects.CreateObjectCollection
	While True
		oSelect = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Select a component for BOX envelope")
		If IsNothing(oSelect) Then Exit While
		oSelected.Add(oSelect)
	End While
	For Each oSelect In oSelected
		Dim Occ As ComponentOccurrence
		If oSelected.Count >= 1 Then
			For i = 1 To oSelected.Count
				Occ = oSelected.Item(i)
				Try
					Dim oDoc As AssemblyDocument
					oDoc = ThisApplication.ActiveDocument
					Dim oCompDef As AssemblyComponentDefinition
					oCompDef = oDoc.ComponentDefinition
					Dim oClientFeatures As ClientFeatures
					oClientFeatures = oCompDef.Features.ClientFeatures
					Dim oOccu As ComponentOccurrence
					oOccu = Occ 'ThisApplication.CommandManager.Pick(kAssemblyOccurrenceFilter, "Select an occurrence in assembly")
					Dim oRangeBox As Box
					oRangeBox = oOccu.RangeBox
					If oRangeBox.MinPoint.DistanceTo(oRangeBox.MaxPoint) > 0.000001 Then
						Dim oTransientBrep As TransientBRep
						oTransientBrep = ThisApplication.TransientBRep
						Dim oEnvelopeBody As SurfaceBody
						oEnvelopeBody = oTransientBrep.CreateSolidBlock(oRangeBox)
						Dim oClientFeaDef As ClientFeatureDefinition
						oClientFeaDef = oClientFeatures.CreateDefinition("Envelope")
						Dim oClientFea As ClientFeature
						oClientFea = oClientFeatures.Add(oClientFeaDef, "MyEnvelope")
						oClientFeaDef = oClientFea.Definition
						Dim oClientGraphics As ClientGraphics
						oClientGraphics = oClientFeaDef.ClientGraphicsCollection.Add("Envelope")
						Dim oGraphicsNode As GraphicsNode
						oGraphicsNode = oClientGraphics.AddNode(oClientGraphics.Count + 1)
						Call oGraphicsNode.AddSurfaceGraphics(oEnvelopeBody)
						oOccu.Visible = False
						oDoc.Update
					End If
				Catch
				End Try
			Next
		End If
	Next
End Sub