Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
ts2.cad3
347 Views, 6 Replies

Write flat pattern area parameter to each sheet metal in the assembly

Hi all, i get this error:"Object variable or With block variable not set" in this simple macro. 

Someone have any tips?

 

 

Sub Main
	
Dim oAssyDoc As AssemblyDocument = ThisApplication.ActiveDocument
Dim oAssyDef As AssemblyComponentDefinition = oAssyDoc.ComponentDefinition
Dim oSSet As SelectSet = oAssyDoc.SelectSet
Dim oDoc As Inventor.Document


	For Each oDoc In oAssyDoc.AllReferencedDocuments
		'verify document type (we are interested in metal sheets only)
		If oDoc.ComponentDefinition.Type = kSheetMetalComponentDefinitionObject Then

			Dim oDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition
			Dim oColl As ComponentOccurrencesEnumerator = oAssyDef.Occurrences.AllReferencedOccurrences(oDoc)
				If oColl.Count > 0 Then
					'select all found components
					Dim oOcc As ComponentOccurrence= oObj
					
					For Each oOcc In oColl
						Call cQM(oOcc, oDoc, oDef)
					Next oOcc
				End If
			End If		
	Next
End Sub

Sub cQM(oOcc, oDoc, oDef)


	Dim oDocName As String = oDoc.DisplayName 

'        If oCompDef.HasFlatPattern = False Then		
'            oCompDef.Unfold 
'			oCompDef.FlatPattern.ExitEdit         
'            'Dim ACTD As Document = TryCast(ThisApplication.ActiveDocument, Document)
'            ACTD.Close()
'        End If        
        Dim extents_area As Double = oDef.Flatpattern.Length * 10 * oDef.Flatpattern.Width * 10
        Dim sfr As Double = extents_area 
        
     
        sfr = CStr(sfr)

        iProperties.Value(oDocName, "Custom", "QTA_MATERIALE") = sfr
		iProperties.Value(oDocName, "Custom", "DIMENSIONI") = ""
			

End Sub

 

Frederick_Law
in reply to: ts2.cad3


@ts2.cad3 wrote:

Hi all, i get this error:"Object variable or With block variable not set" in this simple macro. 

 


Error on which line?

ts2.cad3
in reply to: Frederick_Law

38
Frederick_Law
in reply to: ts2.cad3

Error on every part?

One part don't have flat pattern?

ts2.cad3
in reply to: Frederick_Law

Yes error on every part, all the part have already flat pattern except one, is there a way to create it for parts that don't have it? I noticed that if all the parts have a flat pattern the rule works

marcin_otręba
in reply to: ts2.cad3

sorry, but whole code is messed up, 

main error is in line 17 oObj not declared or set to any value.

also  

iProperties.Value("part1:1", "Project", "Part Number")

 

"part1:1" - it is oOcc.name not oDoc.DisplayName - it will give error as well

 

this code should work for you:

Sub Main
	
Dim oAssyDoc As AssemblyDocument = ThisApplication.ActiveDocument
Dim oAssyDef As AssemblyComponentDefinition = oAssyDoc.ComponentDefinition

Dim oDoc As Inventor.Document
	For Each oOcc As ComponentOccurrence In oAssyDef.Occurrences
		'verify document type (we are interested in metal sheets only)
		If oOcc.Definition.Document.ComponentDefinition.Type = kSheetMetalComponentDefinitionObject Then
			Call cQM( oOcc.Definition.Document)
		End If		
	Next
End Sub

Sub cQM( oDoc As PartDocument)

Dim oDef As SheetMetalComponentDefinition = oDoc.ComponentDefinition
Dim sfr As Double = oDef.FlatPattern.Length * 10 * oDef.FlatPattern.Width * 10
		Try
			oDoc.PropertySets.Item(4).Item("QTA_MATERIALE").Value = sfr
		Catch
			oDoc.PropertySets.Item(4).Add(sfr,"QTA_MATERIALE") 
		End Try
		
		Try
			oDoc.PropertySets.Item(4).Item("DIMENSIONI").Value = ""
		Catch
			oDoc.PropertySets.Item(4).Add("","DIMENSIONI") 
		End Try	
End Sub

 

ts2.cad3
in reply to: ts2.cad3

solved whit
If oDef.HasFlatPattern = False Then
oDef.Unfold
oDef.FlatPattern.ExitEdit

in the Sub cQM