Model items in flattened view

[CPHeineman]

Is there some possibility to automate the dimensions from a sheetmetal-part in the flattened view? I'm currently working on a major macro, which makes supports for pipes in every diameter, with every secondary steel. The 3D part is finished (also thanks to this forum), but now i want to get automatic my drawings from the clamp. the normal views, incl the isometric view (in color) are shown automaticly on the sheet, also thanks to Luke. But i created an additional view, the flatted view. In this view there are bend lines, which have to be dimensioned from the side.

this is what i have now:

CODE:
' Prerequisits: Have a model open
'
' Result: This macro will create a drawing with the standard 3 views and an isometric view
' as well as insert default model dimensions

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swDrawing As DrawingDoc
Dim filename As String
Dim ext As String
Dim fso As Scripting.FileSystemObject
Dim boolstatus As Boolean
Dim bRet As Boolean
Dim bRet2 As Boolean
Dim swView As SldWorks.view
Dim bSheet As Boolean
Dim skPoint As Object
Dim myDimension As Object
Dim myDisplayDim As Object
Dim x As Double
Dim y As Double
Dim swDraw As SldWorks.DrawingDoc
Dim vPos As Variant


Dim longerrors As Long, longwarnings As Long


Sub Main()

Set fso = CreateObject("Scripting.FileSystemObject")
Set swApp = CreateObject("sldworks.application")
Set swModel = swApp.ActiveDoc




If swModel Is Nothing Then Exit Sub

filename = swModel.GetPathName
' Find all files ending in .SLDPRT
ext = UCase(Right(filename, 6))
If ext <> "SLDPRT" And ext <> "SLDASM" Then Exit Sub

Dim curfilename As String
curfilename = Left(filename, Len(filename) - 7) & ".SLDDRW"

' Check whether file already exists
If fso.FileExists(curfilename) Then
If MsgBox(curfilename & " already exists. Overwrite?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
End If

'check if sheetmetal
Dim BendState As Boolean

BendState = swModel.GetBendState
If BendState = True Then
bRet = MsgBox("Product is sheetmetal", vbExclamation, "Hmm..")
bSheet = True
Else
bRet = MsgBox("Product is geen Sheetmetal", vbExclamation, "Hmm..")
bSheet = False
End If



' Get default template
Dim template As String
template = swApp.GetUserPreferenceStringValue(swDefaultTemplateDrawing)
' NewDocument templateName, paperSize, width, height. Paper Size, Width & Height if specified in template are redundant
Set swDrawing = swApp.NewDocument(template, 0, 0, 0)

'apply template
Dim Part As Object
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Sheet1", "SHEET", 0.1970235574837, 0.1139212039046, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.SetupSheet5("Sheet1", 12, 12, 1, 5, True, "n:\solidworks templates\wsps templates\a4 -landscape 2768-vl.slddrt", 0.2794, 0.2159, "Default", True)

'create drawing
If swDrawing Is Nothing Then
MsgBox "Failed to create drawing"
Exit Sub
End If

If (ext = "SLDPRT") Then
swApp.OpenDoc6 filename, swDocPART, swOpenDocOptions_ReadOnly, "", longerrors, longwarnings
Else: swApp.OpenDoc6 filename, swDocASSEMBLY, swOpenDocOptions_ReadOnly, "", longerrors, longwarnings
End If

swDrawing.Create3rdAngleViews2 filename

'isometric
Dim view As view

Set view = swDrawing.CreateDrawViewFromModelView3(filename, "*Isometric", 0.23, 0.15, 0)
bRet2 = view.UseSheetScale
bRet = view.SetDisplayMode3(False, swSHADED, False, True)

' Get sheet size
Dim cursheet As sheet
Dim sheetwidth As Double, sheetheight As Double
Set cursheet = swDrawing.GetCurrentSheet
cursheet.GetSize sheetwidth, sheetheight
Dim vOutline As Variant, vPosition As Variant
Dim viewWidth As Double, viewHeight As Double

' Insert model dimensions
Dim v As view
Set v = swDrawing.GetFirstView ' Sheet
Set v = v.GetNextView ' First view
swDrawing.ClearSelection2 True
While Not v Is Nothing
If v.name <> view.name Then swDrawing.Extension.SelectByID2 v.name, "DRAWINGVIEW", 0, 0, 0, True, -1, Nothing, 0
Set v = v.GetNextView

Wend


If bSheet = True Then
'insert flat view and flip it
FlatView
'insert annotations




Else
'do something else
End If

'Set options
boolstatus = Part.Extension.LoadDraftingStandard("U:\ISO-MODIFIED.sldstd")
'invoegen annotaties in view 1-3
swDrawing.InsertModelAnnotations3 0, 327663, True, True, False, False
boolstatus = Part.Extension.SelectByID2("D1@Sheet-Metal1@normal_clip-1@Drawing View1", "DIMENSION", 0.1041603015184, 0.1030824316703, 0, False, 0, Nothing, 0)
Part.EditDelete



' Save file
save:
filename = Part.GetTitle & ".SLDDRW"
boolstatus = swDrawing.SaveAs2("U:\01_WSPS\" & filename, 0, False, False)
If boolstatus = False Then MsgBox filename & " opgeslagen in map U:\01_WSPS"
If boolstatus = True Then If MsgBox(filename & " niet opgeslagen", vbCritical + vbRetryCancel) = vbRetry Then GoTo save

'swApp.CloseDoc filename
'swApp.CloseDoc curfilename

End Sub

Option Explicit

Sub FlatView()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.view
Dim vOutline As Variant
Dim vPos As Variant
Dim i As Long
Dim lViewNumber As Long
Dim x As Variant
Dim y As Variant
Dim filename As String


Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swDraw = swModel
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
Const NinetyDegreesInRadians = 1.57079632679

filename = swModel.GetPathName

If swView Is Nothing Then
End
Else
swModel.EditRebuild3
lViewNumber = 1
swModel.SetAddToDB (True)
End If


' Do While Not swView Is Nothing

vOutline = swView.GetOutline
vPos = swView.Position

Debug.Print "View = " + swView.name
Debug.Print " Pos = (" & vPos(0) * 1000# & ", " & vPos(1) * 1000# & ") mm"
Debug.Print " Min = (" & vOutline(0) * 1000# & ", " & vOutline(1) * 1000# & ") mm"
Debug.Print " Max = (" & vOutline(2) * 1000# & ", " & vOutline(3) * 1000# & ") mm"
Debug.Print

MsgBox "x = " & vPos(0) * 1000
MsgBox "y = " & vPos(1) * 1000

x = vPos(0)
'y = vPos(1)
y = 0.05

swDraw.CreateFlatPatternViewFromModelView2 filename, "Default", x, y, 0, False
swDraw.DrawingViewRotate (NinetyDegreesInRadians)



End Sub



As you can see, this all works just fine (allmost... )


Can somebody help me out here with dimensioning the bendlines (not by record macro, that will use coordinates and if the clamp changes size, this won't work anymore... i tried )

thank you all very much!

 

[EEnd]

Have you looked into using configurations defined in a design table? If the changes are primarily dimensional, that information can be encapsulated in a design table. Then a drawing can be created for one configuration and then additional drawings generated by changing the configuration referenced by the drawing. If applicable to your project, this would be a much simpler solution than writing a macro to create the model and drawing from scratch each time.

Eric

 

[CPHeineman]

Hi Eric,

Thank for your remark, but unfortunately it is'nt possible to use a designtable, every configuration is possible and the design doesn't have to be limited by the application.

so i do need to make this drawing every time...

And if this one works, every part can be made, using this macro. which saves me an enormouse amount of time!

greetings,
chris