Inventor - Bend Notu Ekleme Ve Silme Kodu

[Alpergk35]

Lazere gidecek olan parçaları lazer templatesine atıyoruz. Lakin silindirde bükülecek parçalarda bu liste içerisinde kesiliyor. Usta radius değerine bakmadığı için açılı olarak büküp geri gönderiyor. Bu lazer templatesinde 10dan büyük radiuslu bükümlerde büküm notunu ve büküm markalama çizgisini silmek ve aynı zamanda büküm notuna açık ve kapalı notu eklemek istiyoruz. Aşağıda şimdiye kadar kullandığımız kodları bırakıyorum.

Kayıt esnasında üst üste not eklemesin diye her seferinde notları silen bu komutu kullanıyoruz

Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument

For Each oSheet In oDoc.Sheets
    oSheet.Activate()
    For Each oNote As BendNote In oSheet.DrawingNotes.BendNotes
        oNote.Delete()
    Next
Next

 Büküm notu eklemek için bu komutu kullanıyoruz

Dim oDoc As DrawingDocument
Dim oSheet As Sheet
Dim oView As DrawingView
Dim oCurve As DrawingCurve
Dim oBendNote As BendNote

oDoc = ThisApplication.ActiveDocument
oSheet = oDoc.ActiveSheet

For Each oView In oSheet.DrawingViews
 For Each oCurve In oView.DrawingCurves
  If oCurve.EdgeType = Inventor.DrawingEdgeTypeEnum.kBendDownEdge _
  Or oCurve.EdgeType = Inventor.DrawingEdgeTypeEnum.kBendUpEdge Then
	' Create the bend note
	oBendNote = oSheet.DrawingNotes.BendNotes.Add(oCurve)
  End If
 Next 'oCurve
Next 'oView

Büküm notuna yazı eklemek içinde bu komutu kullanıyoruz

Sub Main
	'get drawing document you want to target
	oDDoc = ThisDrawing.Document
	
	'specify what text to add after angle in different situations
	'we will use this later in the code
	oMap = ThisApplication.TransientObjects.CreateNameValueMap
	oMap.Add("<90", " (AÇIK) ") 'angle is less than 90
	oMap.Add(">90", " (KAPALI) ") 'angle is greater than 90

	For Each oSheet As Sheet In oDDoc.Sheets
		'if no bend notes on sheet, skip to next sheet
		If oSheet.DrawingNotes.BendNotes.Count = 0 Then Continue For
		oBNotes = oSheet.DrawingNotes.BendNotes
		For Each oBNote As BendNote In oBNotes
			oFBN = oBNote.FormattedBendNote
			'if this bend note does not contain any angle info, skip to next bend note
			If Not oFBN.Contains("<BendAngle") Then Continue For
			'create a variable to hold the text we will be adding after the angle
			Dim oTextToAdd As String = vbNullString
			'isolate and get the angle part of the text
			oParts = oBNote.Text.Split(" ") 'split into multiple sub-strings, by where spaces are
			Dim oAngle As String = vbNullString
			For Each oPart In oParts
				If oPart.Contains("°") Then 'if it contains the 'degree' mark
					oAngle = oPart
				End If
			Next
			'check to make sure we found the angle text
			If String.IsNullOrEmpty(oAngle) Then Continue For 'could not isolate the angle text
			'check angle (extract numerical value from String, then compare)
			If Val(oAngle) < 90 Then
				oTextToAdd = oMap.Value("<90") 'uses the Value of that place in the oMap
			ElseIf Val(oAngle) > 90 Then
				oTextToAdd = oMap.Value(">90") 'uses the Value of that place in the oMap
			End If
			'use our custom Function's below
			oFBN = FixBendAngle(oFBN, oTextToAdd)
			oFBN = FixRadius(oFBN)
			'now finally set the new value
			oBNote.FormattedBendNote = oFBN
		Next
	Next
End Sub

Function FixBendAngle(oFormattedBendNote As String, oTextToPutAfterAngle As String) As String
	'get BendAngle part of formatted text
	oPos1 = oFormattedBendNote.IndexOf("<BendAngle")
	oPos2 = oFormattedBendNote.IndexOf("</BendAngle>") + Len("</BendAngle>")
	oLen = oPos2 - oPos1
	oSubSt = oFormattedBendNote.Substring(oPos1, oLen)
	'MsgBox("oSubSt = " & oSubSt, , "")
	oResult = oFormattedBendNote.Replace(oSubSt, "<BendAngle> </BendAngle>" & oTextToPutAfterAngle)
	Return oResult
End Function

Function FixRadius(oFormattedBendNote As String) As String
	'get Radius part of formatted text
	oPos1 = oFormattedBendNote.IndexOf("<BendRadius")
	oPos2 = oFormattedBendNote.IndexOf("</BendRadius>") + Len("</BendRadius>")
	oLen = oPos2 - oPos1
	oSubSt = oFormattedBendNote.Substring(oPos1, oLen)
	'MsgBox("oSubSt = " & oSubSt, , "")
	oResult = oFormattedBendNote.Replace(oSubSt, "<BendRadius> </BendRadius>")
	Return oResult
End Function

 Büküm çizgisini gizlemek içinde bu komutu kullanıyoruz

'This assumes the drawing is active and the first view on first sheet
'contains flat pattern
Dim drawing As DrawingDocument = ThisDoc.Document
Dim flatPatternView As DrawingView = drawing.Sheets(1).DrawingViews(1)
Dim part As PartDocument = flatPatternView.ReferencedDocumentDescriptor.ReferencedDocument
Dim sheetMetalDef As SheetMetalComponentDefinition = part.ComponentDefinition
Dim flatPattern As FlatPattern = sheetMetalDef.FlatPattern


For Each flatBendResult As FlatBendResult In flatPattern.FlatBendResults
    Dim edge As Edge = FlatBendResult.Edge
    Dim innerRadius As Double = FlatBendResult.InnerRadius
    If innerRadius > 1 Then '[cm]
        Dim edgeDrawingCurves As DrawingCurvesEnumerator = flatPatternView.DrawingCurves(edge)
        For Each edgeDrawingCurve As DrawingCurve In edgeDrawingCurves
            For Each segment As DrawingCurveSegment In edgeDrawingCurve.Segments
                'TODO: Do something useful with drawing curve segment which belongs to bend grater then 1 [cm]
                segment.Visible = False
            Next
        Next
    End If
Next

Lakin radius 10 dan büyükse büküm notunu sil yada ekleme gibi bir düzenleme yapamıyoruz. Bu konuda geri dönüş beklemekteyim. 

@Alpergk35 , konu başlığı daha anlaşılır olması için @Olcay.Kuk tarafından düzenlendi. Önceki başlık "Bend Notu Ekleme Ve Silme Kodu"

[Gokhan_Kaya · Accepted solution]

Merhaba @Alpergk35 

Öncelikle ilogic calışmasnız çok güzel olmuş 

ben sadece 10 dan büyük ise notu silme işlemini ikinci kod için düzeltip ekliyorum 

Dim oDoc As DrawingDocument
Dim oSheet As Sheet
Dim oView As DrawingView
Dim oCurve As DrawingCurve
Dim oBendNote As BendNote
Dim bendradius As Integer
oDoc = ThisApplication.ActiveDocument
oSheet = oDoc.ActiveSheet

For Each oView In oSheet.DrawingViews
 For Each oCurve In oView.DrawingCurves
  If oCurve.EdgeType = Inventor.DrawingEdgeTypeEnum.kBendDownEdge _
  Or oCurve.EdgeType = Inventor.DrawingEdgeTypeEnum.kBendUpEdge Then
	' Create the bend note
	oBendNote = oSheet.DrawingNotes.BendNotes.Add(oCurve)
	Dim bendnotes As String()
	bendnotes = oBendNote.Text.Split(" ")
	bendradius=bendnotes(2).Substring(1,bendnotes(2).Length-1)
	If bendradius>10 Then
		'bend radyus eğer 10 dan büyük ise bu satırın aşagısanda yapılması gerekenleri buraya yazın 
		'ben sadece delete işlemini yapıyorum . Ekleme için yine bu satırın asagısına yazabilirsiniz 
		'İyi çalışmalar
		oBendNote.Delete
		
	End If
	
  End If
 Next 'oCurve
Next 'oView

bu kodu ikinci kod takımı olan note ekleme kodunun yerine ekleyin 

[Alpergk35 · Accepted solution]

Merhaba @Gokhan_Kaya 

Verdiğiniz kod muhteşem bir şekilde çalışıyor öncelikle çok teşekkür ederim. Bizim aynı koşulda bendline silme kodumuzun sağlıklı çalışmadığını farkettim. Mesela yeni bir lazer templatesi açıyorsunuz ilk sacı ekliyorsunuz. Kaydetme eventine eklediğim için kaydedince komut çalışıyor. Lakin kaydettikten sonra ikinci parçayı eklediğimde bu komut bu sac için kesinlikle çalışmamakta. Sizden bu kod içinde bir çalışma yapmanızı rica ederim.

'This assumes the drawing is active and the first view on first sheet
'contains flat pattern
Dim drawing As DrawingDocument = ThisDoc.Document
Dim flatPatternView As DrawingView = drawing.Sheets(1).DrawingViews(1)
Dim part As PartDocument = flatPatternView.ReferencedDocumentDescriptor.ReferencedDocument
Dim sheetMetalDef As SheetMetalComponentDefinition = part.ComponentDefinition
Dim flatPattern As FlatPattern = sheetMetalDef.FlatPattern


For Each flatBendResult As FlatBendResult In flatPattern.FlatBendResults
    Dim edge As Edge = FlatBendResult.Edge
    Dim innerRadius As Double = FlatBendResult.InnerRadius
    If innerRadius > 1 Then '[cm]
        Dim edgeDrawingCurves As DrawingCurvesEnumerator = flatPatternView.DrawingCurves(edge)
        For Each edgeDrawingCurve As DrawingCurve In edgeDrawingCurves
            For Each segment As DrawingCurveSegment In edgeDrawingCurve.Segments
                'TODO: Do something useful with drawing curve segment which belongs to bend grater then 1 [cm]
                segment.Visible = False
            Next
        Next
    End If
Next

İyi Çalışmalar

[Gokhan_Kaya · Accepted solution]

Merhaba @Alpergk35 

Kodun düzeltilmiş hali aşagıdadır

'Bu kural bütün sayfalar ve viewler için gecerlidir
'contains flat pattern
If ThisDoc.Document.DocumentType=DocumentTypeEnum.kDrawingDocumentObject Then
Dim drawing As DrawingDocument = ThisDoc.Document
For i=1 To drawing.Sheets.Count
For Each flatPatternView As DrawingView In drawing.Sheets(i).DrawingViews
Dim part As PartDocument = flatPatternView.ReferencedDocumentDescriptor.ReferencedDocument
Dim sheetMetalDef As SheetMetalComponentDefinition = part.ComponentDefinition
Dim flatPattern As FlatPattern = sheetMetalDef.FlatPattern
For Each flatBendResult As FlatBendResult In flatPattern.FlatBendResults
    Dim edge As Edge = FlatBendResult.Edge
    Dim innerRadius As Double = FlatBendResult.InnerRadius
    If innerRadius > 1 Then '[cm]
        Dim edgeDrawingCurves As DrawingCurvesEnumerator = flatPatternView.DrawingCurves(edge)
        For Each edgeDrawingCurve As DrawingCurve In edgeDrawingCurves
            For Each segment As DrawingCurveSegment In edgeDrawingCurve.Segments
                'TODO: Do something useful with drawing curve segment which belongs to bend grater then 1 [cm]
                segment.Visible = False
            Next
        Next
    End If
Next
Next
Next
End If

Bir önceki düzelttigim kodda bend radius için tam satı degerleri gecerlidir eğer küsüratlı degerler kullanılıyor ise aşagıda ki halini kullanın 

Dim oDoc As DrawingDocument
Dim oSheet As Sheet
Dim oView As DrawingView
Dim oCurve As DrawingCurve
Dim oBendNote As BendNote
Dim bendradius As Double
oDoc = ThisApplication.ActiveDocument
oSheet = oDoc.ActiveSheet

For Each oView In oSheet.DrawingViews
 For Each oCurve In oView.DrawingCurves
  If oCurve.EdgeType = Inventor.DrawingEdgeTypeEnum.kBendDownEdge _
  Or oCurve.EdgeType = Inventor.DrawingEdgeTypeEnum.kBendUpEdge Then
	' Create the bend note
	oBendNote = oSheet.DrawingNotes.BendNotes.Add(oCurve)
	Dim bendnotes As String()
	bendnotes = oBendNote.Text.Split(" ")
	bendradius=bendnotes(2).Substring(1,bendnotes(2).Length-1)
	If bendradius>10 Then
		'bend radyus eğer 10 dan büyük ise bu satırın aşagısanda yapılması gerekenleri buraya yazın 
		'ben sadece delete işlemini yapıyorum . Ekleme için yine bu satırın asagısına yazabilirsiniz 
		'İyi çalışmalar
		oBendNote.Delete
		
	End If
	
  End If
 Next 'oCurve
Next 'oView

 Kolay gelsin 

[Alpergk35 · Accepted solution]

Merhaba @Gokhan_Kaya 

Yazmış olduğunuz kod bir bilgisayarımızda muhteşem derecede güzel çalıştı. Elinize sağlık çok teşekkür ederim. Lakin diğer bilgisayarımızda bend line siliniyor ama bend note eklenmiyor. Yardımcı olmanızı rica ederim.

İyi Çalışmalar

[Gokhan_Kaya · Accepted solution]

merhaba @Alpergk35 

Ben düzeltmeleri sadece sizin gönderdiğiniz kodlara göre yaptım. ekleme kısmında bir değişiklik yok 

programın vermiş olduğu ha nedir ekran görüntüsü paylaşabilir misiniz 

diğer bir olasılık ise sistemin mm değil inç olması olabilir 

çünkü inç ise 10 mm 4 küsürlü bir rakama denk gelecektir 

[Alpergk35]

Gökhan bey inch değilmiş ama hallettik. Birde birşey daha gördük. Aşağıya bırakacağım kod assembly'den direk lazere sipariş listesi çıkartıyor ve tek dxf içerisinde. Lakin biz buna kalınlık malzeme bilgisi ve adet yazdırmak istiyoruz. Birde büküm çizgilerini sarı yapmasını istiyoruz. Bize bu konuda da yardımcı olabilirmisiniz.

Sub Main
	'iLogic Code by Jhoel Forshav - originally posted at https://clintbrown.co.uk/ilogic-export-all-flat-patterns-to-one-dxf
	'Check that the active document is an assembly file
	If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
		MessageBox.Show("This rule can only run from an Assembly file", "DXF-creator", MessageBoxButtons.OK, MessageBoxIcon.Error)
		Exit Sub
	End If
	'Dim the active document as AssemblyDocument
	Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
	'Make sure the assembly is saved
	If oDoc.FullFileName = ""
		MessageBox.Show("Please save the Assembly before running this rule.", "DXF-creator", MessageBoxButtons.OK, MessageBoxIcon.Information)
		Exit Sub
	End If
	'Get the assembly filename without extension
	Dim oAsmName As String = System.IO.Path.GetFileNameWithoutExtension(oDoc.FullFileName)
	'Get the assembly filepath
	Dim oPath As String = System.IO.Path.GetDirectoryName(oDoc.FullFileName)

	'Get the parts only BOM.
	Dim oBOM As BOM = oDoc.ComponentDefinition.BOM
	'Make sure Parts Only is activated
	oBOM.PartsOnlyViewEnabled = True
	'Parts only will be last BomView (difficult to get by name since it's different depending on your language)
	Dim oBOMview As BOMView = oBOM.BOMViews.Item(oBOM.BOMViews.Count)


	'Set a reference to the TransientGeometry object
	Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
	'oX and oY will be used to create points for view placement
	Dim oX As Double = 0
	Dim oY As Double = 0
	'Create the Baseview options to place flatpattern-views
	Dim oBaseViewOptions As NameValueMap
	oBaseViewOptions = ThisApplication.TransientObjects.CreateNameValueMap
	oBaseViewOptions.Add("SheetMetalFoldedModel", False)
	'Set a variable for the drawing document
	Dim oDrawing As DrawingDocument
	'Create a String to return a message if any SM-parts are not saved
	Dim unsavedSmParts As String = ""

	Dim i As Integer = 1
	Dim oInfo As String = ""

	'Traverse Parts Only BOM
	For Each oRow As BOMRow In oBOMview.BOMRows
		Try
			'Get the component definition for the part
			Dim oDef As ComponentDefinition = oRow.ComponentDefinitions(1)
			'Check if the part is SheetMetal
			If TypeOf (oDef) Is SheetMetalComponentDefinition
				'Set a reference to the partdocument
				Dim smPartDoc As PartDocument = oDef.Document
				'Check if the part is saved
				If smPartDoc.FullFileName = "" Then
					If unsavedSmParts = "" Then unsavedSmParts = "The fallowing SM-documents were not saved and therefore " & _
					"no drawingviews were created:" & vbCrLf
					unsavedSmParts = unsavedSmParts & vbCrLf & oDef.Document.DisplayName
					Continue For
				End If
				'Create flatpattern if it doesn't already exist
				If Not oDef.HasFlatPattern
					oDef.Unfold()
					oDef.FlatPattern.ExitEdit()
				End If
				'Create the drawing if it doesn't already exist
				If oDrawing Is Nothing
					oDrawing = ThisApplication.Documents.Add(DocumentTypeEnum.kDrawingDocumentObject, _
					, False)
					'Set the drawings length units to the same as the assemblys length units
					oDrawing.UnitsOfMeasure.LengthUnits = oDoc.UnitsOfMeasure.LengthUnits
				End If

				'Set a reference to the drawing sheet
				Dim oSheet As Sheet = oDrawing.ActiveSheet


				'Create the flatpattern view
				Dim oView As DrawingView = oSheet.DrawingViews.AddBaseView(smPartDoc, oTG.CreatePoint2d(oX, oY), 1 _
				, ViewOrientationTypeEnum.kDefaultViewOrientation, DrawingViewStyleEnum.kHiddenLineRemovedDrawingViewStyle, _
				"FlatPattern", , oBaseViewOptions)

				oView.Name = smPartDoc.DisplayName
				oView.ShowLabel = True

				'Set the position with our oX and oY
				oView.Position = oTG.CreatePoint2d(oView.Position.X + oView.Width / 2, oView.Position.Y)
				'Move oX to place the next view to the right of this one
				oX = oView.Left + oView.Width + 1
				'Remove the bend lines of the view
				RemoveBendLines(oView, oDef.FlatPattern)'You could comment out this line to keep bend lines


				oInfo = oInfo & If (i = 1, "", vbCrLf) & i & ". " & smPartDoc.PropertySets.Item("Design Tracking Properties"). _
				Item("Part Number").Value

				i += 1

				'Close the part
				smPartDoc.Close(True)
			End If
		Catch Ex As Exception
			MsgBox(Ex.Message)
		End Try
	Next
	If oDrawing IsNot Nothing
		'Create the save location string for the DXF
		Dim oDXFName As String = oPath & "\" & oAsmName & "_FlatPatterns.dxf"
		'Save the DXF
		oINI = "" 'Specify your INI file location here (eg C:\TEMP\DXF Export.ini)
		If oINI = "" Then
			MessageBox.Show("You need to specify an INI file location in the code - Look for oINI and set the path", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
		End If
		SaveDXF(oDrawing, oDXFName, oINI)
		'Create the save location string for the information txt
		Dim oInfoName As String = oPath & "\" & oAsmName & "_FlatPatterns.txt"
		'Create the txt
		CreateTXT(oInfo, oInfoName)
	End If
	'Close the drawing
	oDrawing.Close



	'return information about any unsaved parts
	If unsavedSmParts <> "" Then _
	MessageBox.Show(unsavedSmParts, "Some parts were not saved", _
	MessageBoxButtons.OK, MessageBoxIcon.Information)
	'Update the assembly (could be dirty if any flatpatterns were created)	
	oDoc.Update
End Sub

Sub SaveDXF(oDrawing As DrawingDocument, oFileName As String, oIniFile As String)
	'Set a reference to the DFX translator
	Dim DXFAddIn As TranslatorAddIn
	DXFAddIn = ThisApplication.ApplicationAddIns.ItemById("{C24E3AC4-122E-11D5-8E91-0010B541CD80}")
	'Create translation context
	Dim oContext As TranslationContext = ThisApplication.TransientObjects.CreateTranslationContext
	oContext.Type = IOMechanismEnum.kFileBrowseIOMechanism
	'Create options for the translation
	Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
	'Create a DataMedium object
	Dim oDataMedium As DataMedium = ThisApplication.TransientObjects.CreateDataMedium
	'Set the options (which .ini-file to use)
	If DXFAddIn.HasSaveCopyAsOptions(oDrawing, oContext, oOptions) Then
		oOptions.Value("Export_Acad_IniFile") = oIniFile
	End If
	'Set the filename property of the DataMedium object
	oDataMedium.FileName = oFileName
	Try
		'Try to save the DXF
		DXFAddIn.SaveCopyAs(oDrawing, oContext, oOptions, oDataMedium)
		MessageBox.Show("Dxf saved to: " & oFileName, "DXF SAVED", MessageBoxButtons.OK, MessageBoxIcon.Information)
	Catch
		MessageBox.Show("Couldn't save dxf!", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
	End Try
End Sub

Sub RemoveBendLines(oView As DrawingView, oFlattPattern As FlatPattern)
	'Get all the bend edges from the FlatPattern
	Dim oBendEdgesUp As Edges = oFlattPattern.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendUpFlatPatternEdge)
	Dim oBendEdgesDown As Edges = oFlattPattern.GetEdgesOfType(FlatPatternEdgeTypeEnum.kBendDownFlatPatternEdge)

	For Each oEdge As Edge In oBendEdgesUp
		'Get the curves representing these edges in the drawing view
		For Each oCurve As DrawingCurve In oView.DrawingCurves(oEdge)
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				'Set visibility to false
				oSegment.Visible = False
			Next
		Next
	Next
	For Each oEdge As Edge In oBendEdgesDown
		For Each oCurve As DrawingCurve In oView.DrawingCurves(oEdge)
			For Each oSegment As DrawingCurveSegment In oCurve.Segments
				oSegment.Visible = False
			Next
		Next
	Next
End Sub

Sub CreateTXT(oText As String, oFileName As String)
	Dim oTxtWriter As System.IO.StreamWriter = System.IO.File.CreateText(oFileName)
	oTxtWriter.WriteLine(oText)
	oTxtWriter.Close()
End Sub