Jump to content

GetWeldmentState for drawing view on new drawing


carlfred

Recommended Posts

Im trying to place a flat pattern in a weldment drawing if the main view is a preparation weldment state but I get an error with the GetWeldmentState function. I am using this to get the object for the flat pattern.

 

For a new drawing I get the weldState enum 80900 (kPreparationsWeldmentState) but the weld object is still nothing. According to the API help i should get the object also. If I save the document and restart Inventor, opens the exact same drawing and run the code it works just fine. Any idea on why this does not work in the session where I create my drawing?

 

 

        For Each firstView In currSheet.DrawingViews
           i = i + 1
           If firsViewFound = False Then
               Set mainView = firstView
               MsgBox mainView.Scale
               
               [b]Call mainView.GetWeldmentState(weldState, weldObject)[/b]
               firsViewFound = True
           End If
       Next

Edited by carlfred
Link to comment
Share on other sites

Sub TK_newViews()
       Dim drawingDoc As DrawingDocument
       Set drawingDoc = ThisApplication.ActiveDocument
       Dim currSheet As Sheet ' In drawingDoc.Sheets
       Dim docType As Variant
       Set currSheet = drawingDoc.ActiveSheet
       Dim mainView As DrawingView
       Dim viewPosition As Point2d
       Dim newView, BaseForISO As DrawingView
       Dim newDimension As ObjectCollection
       Dim test As Variant
       Dim test1 As Object
       Dim deltaXpos, deltaYpos As Double
       Dim weldObject As Object
       Dim firsViewFound, settingsChanged, partInWeldment As Boolean
       Dim tmpView As DrawingView
       Dim inputStyle As Variant
       Dim weldState As WeldmentStateEnum
       Dim i As Integer
      
       
       i = 0
       Dim firstView As DrawingView
       
       For Each firstView In currSheet.DrawingViews
           i = i + 1
           If firsViewFound = False Then
               Set mainView = firstView
               'Call mainView.GetWeldmentState(weldState, weldObject)
               firsViewFound = True
           End If
       Next
       
       
       
       If Not mainView Is Nothing And i = 1 Then
       'kör endast om en vy hittas!
       
       docType = mainView.ReferencedDocumentDescriptor.ReferencedDocument.DocumentType
       
       'Kontrollerar om objektet som refereras till av main View är en part i en svetssammanställning
       If mainView.ReferencedDocumentDescriptor.ReferencedDocument.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then 'om svets
           On Error Resume Next
           Call mainView.GetWeldmentState(weldState, weldObject)
           If weldState = kPreparationsWeldmentState Then
               If weldObject.Type = kComponentOccurrenceObject Then
                   partInWeldment = True
               End If
           End If
           'MsgBox partInWeldment
           'MsgBox weldObject.Type
       End If
       
       If docType = kPartDocumentObject Or partInWeldment = True Then
           Set newDimension = currSheet.DrawingDimensions.GeneralDimensions.GetRetrievableDimensions(mainView)
           Set test = currSheet.DrawingDimensions.GeneralDimensions.Retrieve(mainView) ', newDimension)' As GeneralDimensionsEnumerator
           mainView.DisplayThreadFeatures = True
           settingsChanged = centerlineViewSet(mainView)
       End If
       
       
       mainView.ViewStyle = kHiddenLineRemovedDrawingViewStyle

       '=========VY1
       'Placerar första vyn ovanför basvyn
       Set viewPosition = ThisApplication.TransientGeometry.CreatePoint2d(5, 5) 'mainView.Position
       Set viewPosition = mainView.Position()
       viewPosition.Y = mainView.Position().Y + max2(mainView.Height * 1.5, 2)
       Set newView = currSheet.DrawingViews.AddProjectedView(mainView, viewPosition, DrawingViewStyleEnum.kFromBaseDrawingViewStyle)
       deltaYpos = max2((newView.Height / 2 + mainView.Height / 2) * 1.5, mainView.Height * 1.5)

       viewPosition.Y = mainView.Position().Y + deltaYpos
       newView.Position = viewPosition

       'Lägger ut dimensioner och centerlinjer om det är en part fil
       If docType = kPartDocumentObject Or partInWeldment = True Then
           Set tmpView = newView
           settingsChanged = centerlineViewSet(tmpView)
           Set tmpView = Nothing
           
           Set newDimension = currSheet.DrawingDimensions.GeneralDimensions.GetRetrievableDimensions(newView)
           Set test = currSheet.DrawingDimensions.GeneralDimensions.Retrieve(newView) ', newDimension)' As GeneralDimensionsEnumerator
           newView.DisplayThreadFeatures = True
           'Set test1 = newView.SetAutomatedCenterlineSettings()
       End If
       'newView.Delete
               
       'Skapa partlist för vy
       Call PlacePartList(currSheet, docType, mainView)
       

       
       '=========VY2
       'Placerar 2a vyn till höger om basvyn
       Set viewPosition = mainView.Position
       viewPosition.X = viewPosition.X + max2(mainView.Width * 1.5, 2)
       Set newView = currSheet.DrawingViews.AddProjectedView(mainView, viewPosition, DrawingViewStyleEnum.kFromBaseDrawingViewStyle)
       'deltaXpos = (newView.Width/2+mainView.Width/2)*1.5
       deltaXpos = max2((newView.Width / 2 + mainView.Width / 2) * 1.5, mainView.Width * 1.5)
       viewPosition.X = mainView.Position().X + deltaXpos
       newView.Position = viewPosition
       If docType = kPartDocumentObject Or partInWeldment = True Then
           Set newDimension = currSheet.DrawingDimensions.GeneralDimensions.GetRetrievableDimensions(newView)
           Set test = currSheet.DrawingDimensions.GeneralDimensions.Retrieve(newView) ', newDimension)' As GeneralDimensionsEnumerator
           
           Set tmpView = newView
           settingsChanged = centerlineViewSet(tmpView)
           Set tmpView = Nothing
           newView.DisplayThreadFeatures = True
           
       End If
       Set BaseForISO = newView
       
       'newView.Delete
       
       '=========VY3 ISO
       'Placerar ISO vy
       Set viewPosition = mainView.Position
       viewPosition.X() = mainView.Position.X() + deltaXpos
       viewPosition.Y() = mainView.Position.Y() + deltaYpos
       Set newView = currSheet.DrawingViews.AddProjectedView(mainView, viewPosition, DrawingViewStyleEnum.kShadedDrawingViewStyle)
       'newView.Delete

       '=========VY4 ISO
       'Placerar iso vy 4 om ej Part
       If Not (docType = kPartDocumentObject Or partInWeldment = True) Then
           Set viewPosition = BaseForISO.Position
           viewPosition.X() = BaseForISO.Position.X() + deltaXpos
           viewPosition.Y() = BaseForISO.Position.Y() + deltaYpos
           Set newView = currSheet.DrawingViews.AddProjectedView(BaseForISO, viewPosition, DrawingViewStyleEnum.kShadedDrawingViewStyle)
           'newView.Delete
       End If
       
       If docType = kPartDocumentObject Or partInWeldment = True Then
           Set viewPosition = mainView.Position
           viewPosition.Y() = mainView.Position.Y() - deltaYpos
           If partInWeldment = True Then
               'MsgBox "Trying to place weldment FP"
               'On Error GoTo 0
               'MsgBox weldObject.ReferencedDocumentDescriptor.ReferencedDocument.Item(1).DocumentType
               test = placeFlatPattern(weldObject.ReferencedDocumentDescriptor.ReferencedDocument(), currSheet, viewPosition, mainView.Scale)
           Else
               test = placeFlatPattern(mainView.ReferencedDocumentDescriptor.ReferencedDocument(), currSheet, viewPosition, mainView.Scale)
           End If
           
       End If
       
       currSheet.Update
       
       
       Else
           MsgBox "Place first view before running script" & vbNl & "The script only functions when 1 view is present on the sheet."
           'MsgBox(mainView.ReferencedDocumentDescriptor.ReferencedDocument.Type)

       End If
       
End Sub

'Funktion som lägger Flatpattern vy nedanför basvyn om FlatPattern existerar

Function placeFlatPattern(oSheetMetalDoc As Object, oSheet As Sheet, insertPoint As Point2d, vScale As Double)
   Dim test As Object
   Dim test1, settingsChanged As Boolean
   Dim InvApplication As Object
   
   If oSheetMetalDoc.SubType <> "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
       'Gör inget mer om dokumentet inte är ett sheet metal
   Else
   
       Set InvApplication = oSheetMetalDoc.Parent

       ' Create a new NameValueMap object
       Dim oBaseViewOptions As NameValueMap
       Set oBaseViewOptions = InvApplication.TransientObjects.CreateNameValueMap

       Call oBaseViewOptions.Add("SheetMetalFoldedModel", False)

       'Create the base view.
       Dim oFpView As DrawingView
       
       Set oFpView = oSheet.DrawingViews.AddBaseView( _
               oSheetMetalDoc, insertPoint, vScale, _
           ViewOrientationTypeEnum.kDefaultViewOrientation, _
           DrawingViewStyleEnum.kHiddenLineDrawingViewStyle, _
           "FlatPattern", , oBaseViewOptions)
   
       Dim newDimensionFP As ObjectCollection
       Dim placeDimensions As Variant
       
       
       Set newDimensionFP = oSheet.DrawingDimensions.GeneralDimensions.GetRetrievableDimensions(oFpView)
       Set placeDimensions = oSheet.DrawingDimensions.GeneralDimensions.Retrieve(oFpView)
       
       
       Dim labelPos As Point2d
       Set labelPos = oFpView.Position
       labelPos.Y = labelPos.Y - oFpView.Height() * 0.6 - oFpView.Label.TextStyle.FontSize()
       oFpView.Name = "FLAT PATTERN"
       oFpView.Label.Position = labelPos
           
       oFpView.ShowLabel = True
       
       settingsChanged = centerlineViewSet(oFpView)
       
       If oFpView.IsFlatPatternView = False Then
           oFpView.Delete
           MsgBox ("Flat pattern view failed for sheet metal part, check existance of flat pattern.")
       End If
      
   End If
End Function

Function max2(lng1 As Double, lng2 As Double) As Double
   max2 = lng1
   If lng2 > lng1 Then max2 = lng2
End Function

Function centerlineViewSet(dView As DrawingView) As Boolean

       Dim test1 As Object
       Dim i As Long
       Dim clSettings As AutomatedCenterlineSettings
       Dim oDrawDoc As DrawingDocument
       
       Set oDrawDoc = dView.Parent.Parent
       Set clSettings = oDrawDoc.DrawingSettings.AutomatedCenterlineSettings '() As DrawingSettings
       'inputStyle = dView.ViewStyle
       'dView.ViewStyle = kHiddenLineDrawingViewStyle
       
       'Här sätts sätts settings för center lines, kan adderas med ytterligare styrande settings enligt AutomatedCenterlineSettings
       clSettings.ApplyToHoles = True
       clSettings.ProjectionParallelAxis = True
       clSettings.ProjectionNormalAxis = True
       'dView.Parent.Parent.Update
       'Sleep (1000)
       
       Call dView.SetAutomatedCenterlineSettings(clSettings)
       'dView.ViewStyle = inputStyle
       centerlineViewSet = True
End Function

Function PlacePartList(currSheet As Sheet, docType As Variant, mainView As DrawingView)
       
       Dim oPlacementPoint As Point2d
       Dim oPartsList As PartsList
       Dim sPartList, sAssemblyList, sWeldList As String
       Dim frameX, frameY As Double
       
       'Definierar listnamn för insättning av rätt typ
       sPartList = "TK_Detalj"
       sAssemblyList = "TK_Smst"
       sWeldList = "TK_Svets"
       
       frameX = 7 / 10  'Justerar partlist i sidled, [rambredd]
       frameY = 7 / 10 + 40 / 10 'Justerar partlist i höjdled, [ramhöjd + huvudhöjd]
       
       
       'tar bot alla tidigare partlists
       Do
           If currSheet.PartsLists.Count > 0 Then
               currSheet.PartsLists.Item(1).Delete
           End If
       
       Loop While currSheet.PartsLists.Count > 0
       
       
       Set oPlacementPoint = ThisApplication.TransientGeometry.CreatePoint2d(currSheet.Width - frameX, 0)
       Set oPartsList = currSheet.PartsLists.Add(mainView, oPlacementPoint)
       oPlacementPoint.Y = 0 - oPartsList.RangeBox.MinPoint().Y + frameY 'Justerar partlist i höjdled
       oPartsList.Position = oPlacementPoint
       
       'Ändrar listtyp beroende på om det är en sammanställning eller part
       If docType = DocumentTypeEnum.kAssemblyDocumentObject Or _
           docType = DocumentTypeEnum.kPresentationDocumentObject Then
           'MsgBox("Sammanställning")
           If mainView.ReferencedDocumentDescriptor.ReferencedDocument.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then 'om svets
               oPartsList.Style = currSheet.Parent.StylesManager.PartsListStyles.Item(sWeldList) '"TK_Svets"
           Else
               oPartsList.Style = currSheet.Parent.StylesManager.PartsListStyles.Item(sAssemblyList) '"TK_Smst"
           End If
       End If
       
       If docType = DocumentTypeEnum.kPartDocumentObject Then
           'MsgBox("Part")
           oPartsList.Style = currSheet.Parent.StylesManager.PartsListStyles.Item(sPartList) '"TK_Part"
       End If

       'oPartsList.delete

End Function

Edited by carlfred
code
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...