Hello
I would like to set my PM on SW2018 so that when importing it, I get the developed view in the "CUT" layer and the lines of folds and ref of parts in the "ENGRAVING" layer.
problem, by going to Ownership of the document on my PM, in "sheet metal", I can't assign a layer to the fold line, nor a different layer to the developed view.
However, when I select the "CUT" layer, only the fold annotation is there.
If you have an idea for me....
A+
Stef'
For me, the layer change in the sheet metal options only concerns the annotations.
If you look closely, there is a frame with the title Folding Note and the option to change the layer is included in it.
To change the slap of the drawing it's in View.
I don't think you can assign a different layer for the fold strokes, the option to change the line font type is available but not found a layer change.
For my part I mark the end of the folds with a macro that puts this marking in a marking layer and in yellow, see if it can suit you or not.
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
Hello @sbadenis
Wow!
That's code just to see what you need to know to get to this, I have hair growing in my head ;-)
Zozo admirant;-) end sub