Get Edge Length

Get Edge Length

chrisw01a
Collaborator Collaborator
265 Views
1 Reply
Message 1 of 2

Get Edge Length

chrisw01a
Collaborator
Collaborator

I'm trying to calculate the total length of the edges on parts. I know this will be simple for someone who does this sort of stuff. Please look at line 183. Once I get the method to calculate the length of one edge, I should be able to figure out everything else I need. I've attached my test part. The total length of the edges in the test part should come to 60". Thanks!

 

'REV 10 (10/10/23)

'verify document type
If ThisApplication.ActiveDocumentType <> Inventor.DocumentTypeEnum.kAssemblyDocumentObject Then
	'MessageBox.Show("Document Type: " & ThisApplication.ActiveDocumentType.ToString)
	MessageBox.Show("Must be run from an Assembly! Program will now exit.")
	Exit Sub
End If

areaAdder = 1.50 'add % to area calc to account for drop cw

oPath = ThisDoc.WorkspacePath()
oJob = oPath.Substring(oPath.LastIndexOf("\") + 1)
'oLogFile = oPath & "\Material Usage.txt"
oLogFile = oPath & "\" & oJob & "_Material Usage.txt"

'MessageBox.Show(oLogFile)


'uncomment/comment to change suffix format
sSuffix = " sq feet"
'sSuffix = " ft^2"
'sSuffix = " sq inch"
'sSuffix = " in^2"

'uncomment/comment to change conversion factor
oConversion_factor = 929.03 'cm to feet
'oConversion_factor = 6.4516 'cm to inch

'uncomment/comment to change tab spacing in output file
sSpacer = vbTab

'create log file if it does not exist
If System.IO.File.Exists(oLogFile) Then
	System.IO.File.Delete(oLogFile)
End If

'create log file
Dim oStreamWriter As System.IO.StreamWriter
oStreamWriter = IO.File.CreateText(oLogFile)
'oStreamWriter.WriteLine(Now())
oStreamWriter.WriteLine("")
oStreamWriter.WriteLine("Totals for ONE unit" & " + " & ((areaAdder - 1) * 100) & "%") 'cw
oStreamWriter.Close()


'[ look at each component

Dim oAssyDoc As AssemblyDocument
oAssyDoc = ThisApplication.ActiveDocument

Dim oAsmCompDef As ComponentDefinition
oAsmCompDef = oAssyDoc.ComponentDefinition

Dim oOcc As ComponentOccurrence
Dim oMatList As New ArrayList
Dim oUniqueList As New ArrayList
Dim oFinalList As New ArrayList

Dim dArea As Double

'iterate through all lowest level occurrences (parts)
For Each oOcc In oAsmCompDef.Occurrences.AllLeafOccurrences 
	'MessageBox.Show(oOcc.Name)
	'if component occurrence is suppressed, skip to next component
	If oOcc.Suppressed Then
		'MessageBox.Show(oOcc.Name & " supressed")
		Continue For
	End If

	Dim oDoc As PartDocument
	oDoc = oOcc.Definition.Document

	Dim oUOM As UnitsOfMeasure
	oUOM = oDoc.UnitsOfMeasure

	'ensure this part is a Sheet Metal Part
	If Not oDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
		'MessageBox.Show("Part is not a Sheet Metal Part: " & oDoc.FullFileName)
		Continue For
	End If

	Dim oDef As SheetMetalComponentDefinition
	oDef = oDoc.ComponentDefinition
	
	oMat = oDef.Material
	'MessageBox.Show(oMat.Name, "debug")
	
	'Don't skip if certain materials
	If Not UCase(oMat.Name) = "CERAMIC TILE" And Not UCase(oMat.Name) = "CBU" And Not UCase(oMat.Name) = "CBUHE" And Not UCase(oMat.Name) = "EMBU" Then
		'skip if x
		If UCase(iProperties.Value(oOcc.Name, "Summary", "Keywords")) = "X" Then
			Continue For
		End If
	End If

	oPrecision = oUOM.LengthDisplayPrecision 'get current precision
	oUOM.LengthDisplayPrecision = 4 'set to 4 places

	oThick = oDef.Parameters.Item("Thickness").Value
	'MessageBox.Show(oThick, "debug")

	oThick = oUOM.GetStringFromValue(oThick, "in")
	oThick = oThick.Replace(Right(oThick, 3), "") ' remove unit string
	oThick = CDblAny(oThick) 'convert back to number
	oThick = FormatNumber(oThick, 4, , , TriState.True) ' format 

	oUOM.LengthDisplayPrecision = oPrecision 'set precision back

	'only add to list if it is unique
	If Not oUniqueList.Contains(oMat.Name & " " & oThick) Then
		oUniqueList.Add(oMat.Name & " " & oThick)
	End If

	Dim oTransaction As Transaction
	oTransaction = ThisApplication.TransactionManager.StartTransaction(oDoc, "Find area")

	'create flat pattern if none exist
	If oDef.FlatPattern Is Nothing Then
		Dim openedView As Inventor.View = Nothing
		If oDoc IsNot ThisApplication.ActiveDocument Then
			openedView = oDoc.Views.Add()
			oDoc.Activate()
		End If

		Try
			'create flat pattern
			oDef.Unfold
			'close flat pattern
			oDef.FlatPattern.ExitEdit

			If openedView IsNot Nothing Then
				openedView.Close()
			End If
		Catch
			MessageBox.Show("Can't create flat pattern for: " & oDoc.FullDocumentName & vbCr & "Program will now exit.")
			Exit Sub
		End Try
	End If

	Dim oFlatPattern As FlatPattern
	oFlatPattern = oDef.FlatPattern

	Dim oFlatFeatures As FlatPatternFeatures
	oFlatFeatures = oFlatPattern.Features

	'Create an Object collection To add the features For suppression
	Dim oFeatCollection As ObjectCollection
	oFeatCollection = ThisApplication.TransientObjects.CreateObjectCollection

	For Each oFeat In oFlatFeatures
		If oFeat.Suppressed = False Then
			'Add feature to suppress to the collection
			oFeatCollection.Add(oFeat)
		End If
	Next

	'suppress everything in this collection
	Try
		oDef.FlatPattern.SuppressFeatures(oFeatCollection)
	Catch
	End Try

	'MessageBox.Show("Debug1")
	'[ get area
	Try
		Dim oSketch As PlanarSketch
		oSketch = oFlatPattern.Sketches.Add(oFlatPattern.TopFace)
		'MessageBox.Show("Debug1")
		
		Dim oEdgeLoop As EdgeLoop
		For Each oEdgeLoop In oFlatPattern.TopFace.EdgeLoops
			'MessageBox.Show("oEdgeLoop.Count: " & oEdgeLoop.Edges.Count)
			If oEdgeLoop.IsOuterEdgeLoop Then
				Exit For
			End If
		Next

		Dim oEdge As Edge
		For Each oEdge In oEdgeLoop.Edges
			oSketch.AddByProjectingEntity(oEdge)
			MessageBox.Show("Edge Length: " & ??)
		Next

		Dim oProfile As Profile
		oProfile = oSketch.Profiles.AddForSolid

		dArea = oProfile.RegionProperties.Area
		sArea = Round(dArea, 3) * areaAdder
		
		'2-22-25 cw
		Dim dLength As Double
		Dim iCutTime As Double
		'get IPS
		Dim iSpeed As Double = 600 / 60
		
		dLength = oProfile.RegionProperties.Perimeter / 2.54
		MessageBox.Show("dLength: " & dLength)
		iCutTime = dLength / iSpeed
		MessageBox.Show("iCutTime (seconds): " & iCutTime)
		
		'MessageBox.Show("oMatlist.Add: " & oDef.Document.FullFileName)
		
		oMatList.Add(oMat.Name & " " & oThick & "|" & sArea)
		oTransaction.Abort
		
	Catch
		MessageBox.Show("Failed to create sketch: " & oDef.Document.FullFileName & vbCr & oDef.Document.FullDocumentName & vbCr & "Program will now exit.")
		Exit Sub
	End Try

Next
']

'[ total areas for same materials
Dim dTotal As Double
Dim sName As String
Dim sPartNumber As String

'get max of mat & thickness string
sMatNameLen_Max = 0
For Each sName In oUniqueList
	'capture max mat name length
	sMatNameLen = Len(sName)
	If sMatNameLen > sMatNameLen_Max Then
		sMatNameLen_Max = sMatNameLen
	End If
Next

'add header dash line calc'd on max mat name length
sDash = "-"
For i = 0 To sMatNameLen_Max + 30 + 10
	sDash = sDash & "-"
Next

'amend log file
oStreamWriter = IO.File.AppendText(oLogFile)
oStreamWriter.WriteLine(sDash)
oStreamWriter.Flush()
oStreamWriter.Close()

For Each sName In oUniqueList

	For Each oItem in oMatList
		'split using char
		Dim sMat_Area As String() = oItem.Split(New Char() {"|"c })
		sMat = sMat_Area(0)
		sArea = sMat_Area(1)
		dArea = CDblAny(sArea) 'get number as a double		

		If sMat = sName Then
			dTotal = dTotal + dArea
			sTotal = Round(dTotal / oConversion_factor, 3)
			sTotal = FormatNumber(sTotal, 3, , , TriState.True) & sSuffix ' format 
		End If
	Next

	'Trace.WriteLine(sName, "iLogic") 'debug 
	'Trace.WriteLine(sMatNameLen_Max, "iLogic") 'debug 
	'Trace.WriteLine(Len(sName)	, "iLogic") 'debug 

	'calc the number of spaces to add
	oNamePad = sMatNameLen_Max - Len(sName)

	oPad = ""
	For k = 0 To oNamePad
		oPad = oPad & " "
	Next

	'Supply the stock sheet part#	
	Select Case sName
		Case "Steel Mild 0.0747"
			sPartNumber = "800003"
		Case "Steel Mild 0.1046"
			sPartNumber = "800010"
		Case "Steel Mild 0.1345"
			sPartNumber = "800009"
		Case "Steel Mild 0.1875"
			sPartNumber = "801001"
		Case "Steel Mild 0.2500"
			sPartNumber = "801002"
		Case "Steel Mild 0.3750"
			sPartNumber = "801004"
		Case "Steel Mild 0.5000"
			sPartNumber = "801005"
		Case "Steel Mild 0.6250"
			sPartNumber = "801009"
		Case "Stainless Steel 0.0747"
			sPartNumber = "800303"
		Case "Stainless Steel 0.1046"
			sPartNumber = "800304"
		Case "Stainless Steel 0.1345"
			sPartNumber = "800305"
		Case "Stainless Steel 0.1875"
			sPartNumber = "801101"
		Case "Stainless Steel 0.2500"
			sPartNumber = "801103"
		Case "Stainless Steel 0.3750"
			sPartNumber = "801104"
		Case "AR 0.1345"
			sPartNumber = "802510"
		Case "AR 0.1875"
			sPartNumber = "802502"
		Case "AR 0.2500"
			sPartNumber = "802504"
		Case "Galvanized 0.1046"
			sPartNumber = "800152"
		Case "CBU 0.2500"
			sPartNumber = "800511"
		Case "CBUHE 0.2500"
			sPartNumber = "800523"
		Case "EMBU 0.2500"
			sPartNumber = "800509"
		Case "CERAMIC TILE 0.2500"
			sPartNumber = "HEX:800600 4X6:800602"
		Case Else
			sPartNumber = "xxxxxx"
	End Select

	'amend log file
	oMessageLine1 = sName & oPad & "  (" & sPartNumber & ")" & sSpacer & ":" & sSpacer & sTotal
	oStreamWriter = IO.File.AppendText(oLogFile)
	oStreamWriter.WriteLine(oMessageLine1)
	oStreamWriter.Flush()
	oStreamWriter.Close()

	dTotal = 0

Next

'Process.Start(oLogFile)
ThisDoc.Launch(oLogFile)

']

 

0 Likes
Accepted solutions (1)
266 Views
1 Reply
Reply (1)
Message 2 of 2

chrisw01a
Collaborator
Collaborator
Accepted solution

Nevermind. I got it. Thanks!

 

Dim oCurveEval As CurveEvaluator = oEdge1.Evaluator
				Dim MinParam As Double
				Dim MaxParam As Double
				Dim Length As Double
				oCurveEval.GetParamExtents(MinParam, MaxParam)
				oCurveEval.GetLengthAtParam(MinParam, MaxParam, Length)
				Length = Round(Length / 2.54, 4)
				dLength = dLength + Length
0 Likes