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

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

ts2.cad3
Enthusiast Enthusiast
938 Views
6 Replies
Message 1 of 7

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

ts2.cad3
Enthusiast
Enthusiast

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

 

0 Likes
Accepted solutions (1)
939 Views
6 Replies
Replies (6)
Message 2 of 7

Frederick_Law
Mentor
Mentor

@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?

Message 3 of 7

ts2.cad3
Enthusiast
Enthusiast
38
0 Likes
Message 4 of 7

Frederick_Law
Mentor
Mentor

Error on every part?

One part don't have flat pattern?

Message 5 of 7

ts2.cad3
Enthusiast
Enthusiast

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

0 Likes
Message 6 of 7

marcin_otręba
Advisor
Advisor

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

 

Hi, maybe you want to vote my:

Ideas

or check my apps:

DrawingTools   View&ColoringTools   MRUFolders   auto-save-replace

Message 7 of 7

ts2.cad3
Enthusiast
Enthusiast
Accepted solution
solved whit
If oDef.HasFlatPattern = False Then
oDef.Unfold
oDef.FlatPattern.ExitEdit

in the Sub cQM
0 Likes