Bei mir betrifft der Layerwechsel in den Blechoptionen nur die Beschriftungen.
Wenn man genau hinschaut, gibt es einen Rahmen mit dem Titel Folding Note und darin ist die Option enthalten, die Ebene zu wechseln.
Um den Slap der Zeichnung zu ändern, befindet er sich in der Ansicht.
Ich glaube nicht, dass Sie den Faltenstrichen eine andere Ebene zuweisen können, die Option zum Ändern der Linienschriftart ist verfügbar, aber es wurde keine Ebenenänderung gefunden.
Ich für meinen Teil markiere das Ende der Falten mit einem Makro, das diese Markierung in eine Markierungsschicht und in Gelb setzt, um zu sehen, ob es Ihnen passt oder nicht.
Option Explicit
Dim swApp As Object
Dim swDraw As SldWorks.DrawingDoc
Dim swModel As SldWorks.ModelDoc2
Dim swView As SldWorks.View
Dim swSketch As SldWorks.Sketch
Dim swMathUtil As SldWorks.MathUtility
Dim BendlinesArr As Variant
Dim Bendline As Variant
Dim swModelToViewXForm As SldWorks.MathTransform
Dim swModelToSketchXForm As SldWorks.MathTransform
Dim swDrawingToViewXForm As SldWorks.MathTransform
Dim swSketchLine As SldWorks.SketchLine
Dim swSkStartPt As SldWorks.SketchPoint
Dim swSkEndPt As SldWorks.SketchPoint
Dim swSketchSeg As SldWorks.SketchSegment
Dim nPt(2) As Double
Dim vPt As Variant
Dim swStartPt As SldWorks.MathPoint
Dim swEndPt As SldWorks.MathPoint
Dim X1 As Double, Y1 As Double, X2 As Double, Y2 As Double, X3 As Double, Y3 As Double, X4 As Double, Y4 As Double
Dim Length As Double, Delta As Double
Dim Marquage As String
Public longMarquage As Variant
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
'On récupère la valeur de propriété
readProperties
Debug.Print "Marquage:" & Marquage
If Marquage <> "" Then
'On lance la fonction supression du marquage existant
suppressMarquage
Debug.Print "Suppression marquage lancé"
End If
'Ajout du marquage
Set swMathUtil = swApp.GetMathUtility
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
'ajout SD question longueur de marquage
Do
longMarquage = InputBox("Longueur du marquage en mm?" & vbNewLine & "[valeur entre 2 et 20mm maxi]", "Longueur marquage", 5) 'La variable reçoit la valeur entrée dans l'InputBox
If longMarquage = "" Then Exit Sub
Loop While ((longMarquage < 2) Or (longMarquage > 20) Or (Not IsNumeric(longMarquage)))
'On lance la fonction addMarquageProperties
addMarquageProperties longMarquage
'ajout du calque pour le marquage
Dim swLayerMgr As SldWorks.LayerMgr
Set swLayerMgr = swModel.GetLayerManager
Dim SavedLayerName As String
SavedLayerName = swLayerMgr.GetCurrentLayer
'pour créer dans un nouveau calque ci-dessous
swLayerMgr.AddLayer "Marquage", "", 0, 0, 0
swLayerMgr.SetCurrentLayer "Marquage"
'début du marquage
While Not swView Is Nothing
If swView.IsFlatPatternView Then
swDraw.ActivateView swView.GetName2
Debug.Print swView.GetBendLineCount
If swView.GetBendLineCount > 0 Then
BendlinesArr = swView.GetBendLines
For Each Bendline In BendlinesArr
Set swSketchLine = Bendline
If swSketchLine.IsBendLine Then
Set swSkStartPt = swSketchLine.GetStartPoint2
Set swSkEndPt = swSketchLine.GetEndPoint2
Set swSketch = swSketchLine.GetSketch
Set swModelToSketchXForm = swSketch.ModelToSketchTransform.Inverse
Set swModelToViewXForm = swView.ModelToViewTransform
Set swDrawingToViewXForm = drawingToViewTransform(swView).Inverse
nPt(0) = swSkStartPt.X
nPt(1) = swSkStartPt.Y
nPt(2) = swSkStartPt.Z
vPt = nPt
Set swStartPt = swMathUtil.CreatePoint(vPt)
Set swStartPt = swStartPt.MultiplyTransform(swModelToSketchXForm)
Set swStartPt = swStartPt.MultiplyTransform(swModelToViewXForm)
Set swStartPt = swStartPt.MultiplyTransform(swDrawingToViewXForm)
nPt(0) = swSkEndPt.X
nPt(1) = swSkEndPt.Y
nPt(2) = swSkEndPt.Z
vPt = nPt
Set swEndPt = swMathUtil.CreatePoint(vPt)
Set swEndPt = swEndPt.MultiplyTransform(swModelToSketchXForm)
Set swEndPt = swEndPt.MultiplyTransform(swModelToViewXForm)
Set swEndPt = swEndPt.MultiplyTransform(swDrawingToViewXForm)
X1 = swStartPt.ArrayData(0)
Y1 = swStartPt.ArrayData(1)
X2 = swEndPt.ArrayData(0)
Y2 = swEndPt.ArrayData(1)
Set swSketchSeg = swSketchLine
'défini la longueur de marquage comme égal à la variable précédemment rentrée
Delta = longMarquage / 1000
Length = swSketchSeg.GetLength
X3 = (X2 - X1) * Delta / Length + X1
Y3 = (Y2 - Y1) * Delta / Length + Y1
X4 = (X1 - X2) * Delta / Length + X2
Y4 = (Y1 - Y2) * Delta / Length + Y2
'supprimer l'apostrophe ci-dessous pour enlever les contraintes automatiques
swModel.SetAddToDB True
Set swSketchSeg = swModel.SketchManager.CreateLine(X1, Y1, 0#, X3, Y3, 0#)
swSketchSeg.Color = RGB(255, 255, 0)
Set swSketchSeg = swModel.SketchManager.CreateLine(X2, Y2, 0#, X4, Y4, 0#)
swSketchSeg.Color = RGB(255, 255, 0)
'supprimer l'apostrophe ci-dessous pour enlever les contraintes automatiques
swModel.SetAddToDB False
End If
Next
End If
End If
Set swView = swView.GetNextView
Wend
'mise en place des lignes de marquages dans le calque monCalque
swLayerMgr.SetCurrentLayer SavedLayerName
'swModel.ClearSelection2 True
'ajout de l'annotation marquage
Dim myNote As SldWorks.Note
Dim myAnnotation As SldWorks.Annotation
Dim boolstatus As Boolean
Set myNote = swModel.InsertNote("Marquage laser")
If Not myNote Is Nothing Then
myNote.SetTextVerticalJustification (swTextAlignmentVertical_e.swTextAlignmentBottom)
Set myAnnotation = myNote.GetAnnotation()
End If
swModel.ClearSelection2 True
swModel.WindowRedraw
End Sub
Public Function drawingToViewTransform(swView As SldWorks.View) As SldWorks.MathTransform
Dim swMathUtil As SldWorks.MathUtility
Dim transformData(15) As Double
Set swMathUtil = swApp.GetMathUtility
transformData(0) = Cos(swView.Angle)
transformData(1) = Sin(swView.Angle)
transformData(2) = 0#
transformData(3) = -Sin(swView.Angle)
transformData(4) = Cos(swView.Angle)
transformData(5) = 0#
transformData(6) = 0#
transformData(7) = 0#
transformData(8) = 1#
transformData(9) = swView.Position(0)
transformData(10) = swView.Position(1)
transformData(11) = 0#
'transformData(12) = 1#
'modification ci-dessous
transformData(12) = swView.ScaleDecimal
transformData(13) = 0#
transformData(14) = 0#
transformData(15) = 0#
Set drawingToViewTransform = swMathUtil.CreateTransform(transformData)
End Function
Public Function addMarquageProperties(longMarquage)
'Dim swModel As Object
Dim bret As Boolean
Dim swCustProp As CustomPropertyManager
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swCustProp = swModel.Extension.CustomPropertyManager("")
bret = swCustProp.Add3("Marquage", swCustomInfoType_e.swCustomInfoText, longMarquage, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Debug.Print "Propriété Marquage:" & longMarquage
End Function
Public Function suppressMarquage()
Dim swModel As Object
Dim vSkSegArr As Variant
Dim vSkSeg As Variant
Dim swSkSeg As SldWorks.SketchSegment
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Numberline As Integer
Dim lNumSegments As Long
Dim myModelView As Object
'On supprime le marquage existant
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set myModelView = swModel.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set swView = swDraw.GetFirstView.GetNextView
lNumSegments = swView.GetLineCount2(1)
If lNumSegments > 0 Then
Set swSketch = swView.GetSketch
vSkSegArr = swSketch.GetSketchSegments
For Each vSkSeg In vSkSegArr
Set swSkSeg = vSkSeg
boolstatus = swModel.Extension.SelectByID2(swSkSeg.GetName, "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
swModel.EditDelete
Next vSkSeg
End If
'On supprime l'annotation marquage
Dim bFind As Boolean
Dim swNote As SldWorks.Note
Dim swAnn As SldWorks.Annotation
Dim bret As Boolean
Set swNote = swView.GetFirstNote
Do While Not swNote Is Nothing
bFind = False
Debug.Print "Note:" & swNote.GetText
If swNote.GetText Like "*Marquage laser*" Then
bFind = True
Debug.Print "bFind:" & bFind
Set swAnn = swNote.GetAnnotation
bret = swAnn.Select2(True, 0)
Set swNote = swNote.GetNext
swModel.EditDelete
End If
If Not bFind Then Set swNote = swNote.GetNext
Loop
End Function
Function readProperties()
Marquage = swModel.GetCustomInfoValue("", "Marquage")
End Function
