carlfred Posted December 19, 2014 Share Posted December 19, 2014 (edited) 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 December 19, 2014 by carlfred Quote Link to comment Share on other sites More sharing options...
carlfred Posted December 19, 2014 Author Share Posted December 19, 2014 (edited) 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 December 19, 2014 by carlfred code Quote Link to comment Share on other sites More sharing options...
SLW210 Posted December 19, 2014 Share Posted December 19, 2014 Please read the Code Posting Guidelines and edit your post to include the Code in Code Tags. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.