Hi All,
Its that time again when I get to a point with my macro (VBA) and cannot seem to figure out what I am doing wrong.
The following routine is run from an IDW with a base drawing view.
I am trying to automate the placement of the associated flat pattern
1) Open open the part
2) Delete if present and then generate the flat pattern
3) Place the flat pattern at the correct scale on the sheet at an arbitraty position
My code is as follows but it fails on the final call to place the view with 'Object doesn't support property or method'
Public Sub test() ' trying to place flat pattern from base drawing view
Dim oPartDoc As PartDocument
Dim oDwgDoc As DrawingDocument
Set oDwgDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
Set oSheet = oDwgDoc.ActiveSheet 'On Error Resume Next 'GoTo err:
Dim oDrawingView As DrawingView
Set oDrawingView = oSheet.DrawingViews(1)
Dim oViewScale As Double
Set oViewScale = oDrawingView.Scale
Debug.Print oViewScale
Set oPartDoc = oSheet.DrawingViews(1).ReferencedDocumentDescriptor.ReferencedDocument
Debug.Print oPartDoc.FullFilename
ThisApplication.Documents.Open (oPartDoc.FullFilename)
Dim oCompDef As SheetMetalComponentDefinition
Set oCompDef = oPartDoc.ComponentDefinition
oPartDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
If oCompDef.HasFlatPattern Then
oCompDef.FlatPattern.Delete
Else
oCompDef.Unfold
oCompDef.FlatPattern.ExitEdit
End If
'oPartDoc.Close
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
Call oOptions.Add("SheetMetalFoldedModel", False)
Dim oFlatPatternPoint As Point2d
Set oFlatPatternPoint = ThisApplication.TransientGeometry.CreatePoint2d(50, 50)
oDwgDoc.Activate
Dim oFlatPatternView As DrawingView
Set oFlatPatternView = oSheet.oDrawingViews.AddBaseView(oPartDoc, oFlatPatternPoint, 0.125, kDefaultViewOrientation, _
kHiddenLineRemovedDrawingViewStyle, , , oOptions)
End Sub
Anybody solved this problem before?
Regards
Mark
Solved! Go to Solution.
Solved by JelteDeJong. Go to Solution.
Good morning Mark,
here is the flats code i run to create a flat from a part file, it checks to see if the drawing file exists then adds the flat view.
i hope this helps, but sometimes you have to declare the part file you are creating the flat from , and then you have to use the object of the part file to create the view, i.e.: not a string to declare where the flat pattern is coming from
Sub CreateFlats()
Dim oIDWDoc As DrawingDocument
Dim FileExist As Object
Set FileExist = CreateObject("Scripting.FileSystemObject")
Dim ActiveDoc As PartDocument
Set ActiveDoc = ThisApplication.ActiveDocument
'get project template path
Dim ActiveProject As DesignProject
Set ActiveProject = ThisApplication.DesignProjectManager.ActiveDesignProject
TemplatePath = ActiveProject.TemplatesPath & "\PHS_West\"
TemplateFile = TemplatePath & "PHS_West.idw"
fileName = Replace(ActiveDoc.FullFileName, Right(ActiveDoc.FullFileName, 4), "_Flat" & ".idw")
'check to see if idw exists
If FileExist.FileExists(fileName) = False Then
'create drawing file
Set oIDWDoc = ThisApplication.Documents.Add(kDrawingDocumentObject, TemplateFile, True)
Call oIDWDoc.SaveAs(fileName, False)
Else
Set oIDWDoc = ThisApplication.Documents.Open(fileName, True)
End If
Set TopPos = ThisApplication.TransientGeometry.CreatePoint2d(28, 21.5)
Dim oBaseViewOptions As NameValueMap
Set oBaseViewOptions = ThisApplication.TransientObjects.CreateNameValueMap
Call oBaseViewOptions.Add("SheetMetalFoldedModel", False)
Dim oFlatView As DrawingView
Set oFlatView = oIDWDoc.ActiveSheet.DrawingViews.AddBaseView(ActiveDoc, TopPos, 0.75, kFrontViewOrientation, kHiddenLineRemovedDrawingViewStyle, , , oBaseViewOptions)
Call oFlatView.RotateByAngle(1.5707963267949, False)
oFlatView.Name = "FlatView"
Set SymbolAdd = oIDWDoc.SketchedSymbolDefinitions.AddFromLibrary("PHS West.idw", "SHEET METAL, FLAT", True)
Set Pos = ThisApplication.TransientGeometry.CreatePoint2d(1.904, 1.27)
Set SybmolAdd = oIDWDoc.Sheets(1).SketchedSymbols.Add(SymbolAdd, Pos)
SybmolAdd.Static = True
End Sub
Hi Andrew,
Thanks for your replies, I will have a trawl through the first example - see if I can work out how to integrate it into my code.
The second suggestion promised to be easier to work with but .ReferencedDocuments does not come up as a object of the drawingviews.item object, only ReferencedDocumentsDescriptor
Regards
Mark
i apologize, i was missing part of the object address:
dim oPartDoc as partdocument
Set oPartDoc = oSheet.DrawingViews.item(1).ReferencedFile.DocumentDescriptor.ReferencedDocument
Hi Andrew,
I have changed that line but it did actually work in as much as the debug output returns the correct file path/name. It goes through the open file, build flat patterns, set the drawing view defaults all ok.
Its just the call to set the drawing view that it constantly falls down on.
I will rewrite the oPartDoc def routine to use the path string and see if that makes a difference as you suggested
Regards
Mark
I modified that bit of the code to be
Dim oFilePath As String
oFilePath = oSheet.DrawingViews.Item(1).ReferencedDocumentDescriptor.FullDocumentName
Debug.Print oFilePath
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.Documents.Open(oFilePath)
It needed the referenced documentdescriptor.fullfile name instead of the line you suggested and it works pretty much as before - the debug prints the filepath/name correctly and the partdoc assignment functions and it goes through the flat pattern routine again.
But it still fails on the view creation with the method not supported error
I wonder if the drawing view options and/or sytax in at fault, maybe the error is obvious and I just cannot see it for looking
just a quick thought, try creating a view with out the flatpattern view option.
lets see if we can create a drawing view. some of the other reasons are the drawing is not resoloved, that will keep you from running this kind of code, and sometimes i will go into a new sub routine and perfect getting the base view added, then add in all the other fluff to make it what i want.
you could try this iLogic rule:
Dim doc As DrawingDocument = ThisApplication.ActiveDocument
Dim sheet As Sheet = doc.ActiveSheet
Dim view As DrawingView = sheet.DrawingViews(1)
Dim scale As Double = view.Scale
Dim refDoc As PartDocument = sheet.DrawingViews(1).ReferencedDocumentDescriptor.ReferencedDocument
refDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}"
ThisApplication.Documents.Open(refDoc.FullFileName)
Dim def As SheetMetalComponentDefinition = refDoc.ComponentDefinition
If def.HasFlatPattern Then
def.FlatPattern.Delete()
Else
def.Unfold()
def.FlatPattern.ExitEdit()
End If
Dim oOptions As NameValueMap = ThisApplication.TransientObjects.CreateNameValueMap
oOptions.Add("SheetMetalFoldedModel", False)
Dim oFlatPatternPoint As Point2d = ThisApplication.TransientGeometry.CreatePoint2d(sheet.Width / 2, sheet.Height / 2)
doc.Activate()
Dim oFlatPatternView As DrawingView = sheet.DrawingViews.AddBaseView(refDoc, oFlatPatternPoint, scale,
ViewOrientationTypeEnum.kDefaultViewOrientation, DrawingViewStyleEnum.kHiddenLineRemovedDrawingViewStyle,
, , oOptions)
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
Many thanks for your help Jelte,
That worked perfectly straight out of the box
I have been resisting learning iLogic for too long now, looks like I may have to bite the bullet, just cannot get on with the programming interface as I spent too long with vba
Thanks again and also to Andrew for his help
Mark
If anyone is interested, it look like a good old syntax error in this line
Set oFlatPatternView = oSheet.oDrawingViews.AddBaseView(oPartDoc, oFlatPatternPoint, 0.125, kDefaultViewOrientation, _ kHiddenLineRemovedDrawingViewStyle, , , oOptions)
I think oDrawingViews was the problem all along - studied Jelte code and changed it to DrawingViews and presto it works - Thanks again everyone
Can't find what you're looking for? Ask the community or share your knowledge.