Update Mass rules that used LOD's to now use Modelstates

Update Mass rules that used LOD's to now use Modelstates

sfarrancam
Participant Participant
100 Views
0 Replies
Message 1 of 1

Update Mass rules that used LOD's to now use Modelstates

sfarrancam
Participant
Participant

Hello, 

 

I had three rules that worked well in Inventor 2016 because they involved the use of LOD's.

Now I am using Inventor 2025 and they do not work because LOD's don't exist and there is now modelstates.

 

I am new to 2025 and don't really have any idea how modelstates work yet.

I was wondering if someone could help me re-write the two rules if possible because they worked quite well.

First rule would scan through the assembly and create an LOD based of any view reps then create a custom iproperty for each LOD with the mass of that particular view. 

'get RepresentationsManager
Dim repMgr As RepresentationsManager = ThisApplication.ActiveDocument.ComponentDefinition.RepresentationsManager

 'record current LevelOfDetailRepresentation
Dim oCurrentRepName As String  = repMgr.ActiveLevelOfDetailRepresentation.Name
Dim oRep As LevelOfDetailRepresentation
Dim oRepName 
Dim oMass

For Each oRep In repMgr.LevelOfDetailRepresentations

    oRepName = oRep.Name
	'activate this LOD
	repMgr.LevelOfDetailRepresentations.Item(oRepName).Activate
	'get mass
	oMass = iProperties.Mass
	'Round Mass
	mymass = Round(iProperties.Mass)
	'update value of custom property
	iProperties.Value("Custom", oRepName) = mymass
Next
'restore
repMgr.LevelOfDetailRepresentations.Item(oCurrentRepName).Activate

 

The second rule was never perfected but it worked for the time being. In the drawing I would run the rule which would pop up the open dialogue box, I would select the assembly model I was working on then the rule would copy all custom iproperties from the model and save them to the drawing.

Sub Main()
	'assumes that we are running the rule from the source document.
	Dim TargetDrawing As Inventor.Document = ThisApplication.ActiveDocument
	Dim SourceDrawing As Inventor.Document

	'Set File Selection dialogue object
	Dim oFileDlg As Inventor.FileDialog = Nothing
	InventorVb.Application.CreateFileDialog(oFileDlg)
	oFileDlg.InitialDirectory = oOrigRefName
	oFileDlg.CancelError = True

	'Set the error handling to next (needed for the detection user pressing cancel)
	On Error Resume Next

	oFileDlg.ShowOpen()
	If Err.Number <> 0 Then
		Return
	'check if string is empty
	ElseIf oFileDlg.FileName <> "" Then
		selectedfile = oFileDlg.FileName
	End If
	'open the selected source drawing, using the false setting to open the document Hidden
	SourceDrawing = ThisApplication.Documents.Open(selectedfile,False)
	On Error Goto 0

	'Define both User defined Property sets
	Dim TargetPorps As PropertySet = TargetDrawing.PropertySets.Item("Inventor User Defined Properties")
	Dim SourceProps As PropertySet = SourceDrawing.PropertySets.Item("Inventor User Defined Properties")

	'declare the property variable
	Dim oProp As Inventor.Property

	'iterate though each user property in the source drawing and create
	For Each oProp In SourceProps
		On Error Resume Next
		'MessageBox.Show("Trying To add value: " & oProp.Value, "Message for debugging purposes")
		TargetPorps.Add(oProp.Value, oProp.Name)
		'MessageBox.Show("Err.Number: " & Err.Number, "Message for debugging purposes")

		If Err.Number = 5 Then
			'MessageBox.Show("Value is already there: " & oProp.Value, "Message for debugging purposes")
			Dim InvPropery As [Property]
			InvPropery = TargetPorps.Item(oProp.Name)
			InvPropery.Value = oProp.Value
		End If
	Next
	'Close the source drawing without saving
	'SourceDrawing.Close(True)
	InventorVb.DocumentUpdate()

	MessageBox.Show("Done copying!", "Custom iProperties copy tool")

End Sub

 

Now the third rule I had set to trigger before save and it would scan the drawing for first view, it would find the custom iproperty named the same as the first view and then populate the prompted entry in the titleblock called Weight. This would give me an estimated mass based on the model view rep of the assembly. 

Sub Main     
Dim oDDoc As DrawingDocument = TryCast(ThisDoc.Document, Inventor.DrawingDocument)     
If oDDoc Is Nothing Then Return          
Dim oTBDefs As TitleBlockDefinitions = oDDoc.TitleBlockDefinitions     
Dim oTBDef As TitleBlockDefinition = Nothing          
For Each oTBD As TitleBlockDefinition In oTBDefs         
If oTBD.Name = "ASC-TB-M-D" Then             
oTBDef = oTBD         
End If     
Next 'oTBD          
If oTBDef Is Nothing Then         
MsgBox("The specified TitleBlockDefinition could not be found. Exiting rule.", vbCritical, "iLogic")         
Return 'exits this whole Sub routine     
End If          
Dim oSheets As Inventor.Sheets = oDDoc.Sheets     
Dim oSheet As Inventor.Sheet     
Dim oOriginallyActiveSheet As Inventor.Sheet = oDDoc.ActiveSheet          
For Each oSheet In oSheets         
If oSheet.DrawingViews.Count = 0 Then Continue For 'skip to next sheet                  
oSheet.Activate                  
Dim oViews As DrawingViews = oSheet.DrawingViews         
Dim oView As DrawingView = oViews.Item(1)         
Dim sSheetName As String = oSheet.Name.Split(":")(0)                  
Dim oCustomProps As Inventor.PropertySet = oView.ReferencedDocumentDescriptor.ReferencedDocument.PropertySets.Item("Inventor User Defined Properties")         
Dim oWeight As String = ""         
Dim oScale As String = ""          
If oView.ActiveDesignViewRepresentation <> "" Then             
Try                 
oWeight = oCustomProps.Item(oView.ActiveDesignViewRepresentation).Value             
Catch ex As Exception             
End Try         
End If                  
' Check if the first drawing view has a scale defined         
If oView.Scale <> 0 Then             
oScale = oView.ScaleString         
End If                  
If oSheet.TitleBlock IsNot Nothing Then             
oSheet.TitleBlock.Delete         
End If                  
Dim oPromptStrings(2) As String         
oPromptStrings(0) = sSheetName         
oPromptStrings(1) = oWeight         
oPromptStrings(2) = oScale                  
oSheet.AddTitleBlock(oTBDef, , oPromptStrings)         
oSheet.Update 'update the sheet, if necessary     
Next 'oSheet          
oOriginallyActiveSheet.Activate 'restore originally active sheet to active 
End Sub

 

I am hoping the first two rules can simply be adjusted but I am not sure. I received help for the above three rules either directly from posting or I scoured the forum to find something that fit and made it work.

 

Thanks in advance!

0 Likes
101 Views
0 Replies
Replies (0)