Hello all,
since a long time I'm dreaming of a Macro to automate the following process that we use every day. We use it to highlight connectors so people can build our product easier.
We manually do the following:
In a drawing view we select a whole set of components (the connectors). Afterwards we change the color to green (using properties) & press hidden lines. This way you can clearly see where you need to place the connectors.
-> see .pdf attached with some pictures making it all clear
I'm being busy to create the code for this but I'm stuck over adding occurrences to a selection set so I can then apply the hidden line command
This is my code so far:
Sub AutoColor() 'Step 1 Select a drawing view ' Get the active drawing document. Dim drawDoc As DrawingDocument Set drawDoc = ThisApplication.ActiveDocument ' Have the user select a drawing view. Dim drawView As DrawingView Set drawView = ThisApplication.CommandManager.Pick(kDrawingViewFilter, "Select a drawing view.") Dim docDesc As DocumentDescriptor Set docDesc = drawView.ReferencedDocumentDescriptor ' Verify that the selected drawing view is of an assembly. If docDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then MsgBox "The selected view must be of an assembly." Exit Sub End If ' Get the component definition for the assembly. Dim asmDef As AssemblyComponentDefinition Set asmDef = docDesc.ReferencedDocument.ComponentDefinition 'Step 2 Call the function that selects the correct occurrences Call SelectOcc(drawView, asmDef.Occurrences) 'Step 3 change to hidden lines Dim oControlDef As ControlDefinition Set oControlDef = ThisApplication.CommandManager.ControlDefinitions.Item("DrawingBodyHiddenLinesCtxCmd") oControlDef.Execute 'Step 4 for all components in selection, select all lines of them 'Step 5 place all lines on new layer with green color End Sub Private Sub SelectOcc(drawView As DrawingView, Occurrences As ComponentOccurrences) ' Iterate through the current collection of occurrences. Dim occ As ComponentOccurrence For Each occ In Occurrences 'check if the occurence is the folder "03 PARTS", if it is then proces, else ignore ' the file location should be adjusted so it suits your files Dim OccFullLocation As String OccFullLocation = occ.ReferencedDocumentDescriptor.FullDocumentName If Left(OccFullLocation, 33) = "O:\04 R&D\08 beCAD 2013\03 PARTS\" Then 'MsgBox ("It is a part") ' ' '<<<<<HERE SHOULD BE THE CODE TO ADD THE OCC TO THE SELECTIONSET>>>> ' End If Next End Sub
Step 1 works
Step 3 works
Step 4 & 5 are for a later moment
Step 2 calls the sub "SelectOCC". this sub cycles true the occurrences, I can filter them on file location so I only get the components needed (the connectors). In theory it should be possible to add the given occurrences to the selection set so I can run Step 3 afterwards on it.
But I don't succeed in doing this, I've tried countless of methods and went to this forum and the help but without success 😞
for the man (woman) helping me: Thanks!
Solved! Go to Solution.
Solved by Vladimir.Ananyev. Go to Solution.
I went a little bit further on this and I notice that I am working in the wrong environment with my code.
I am messing with the occurences in the assembly environment and not in the drawing environment.
so new question's:
1) can you address the occurrences of an assembly IN the drawing environment using the API? just like the model tree in the drawing env.
2) if not would a possible method be:
-> will (A) (B) (C) be possible true the API?
thx!
C
You may consider the following workflow.
Initial state:
Active document is your drawing document.
Task:
You want to select all graphics that is associated with connectors. Their part files are saved in the subfolder "O:\04 R&D\08 beCAD 2013\03 PARTS\". Then you want to change color and line style for all connectors.
Possible workflow:
1. Get the reference to the main assembly from the base view.(oAssyDoc)
2. Get the reference to the collection of all documents referenced by main assembly (oAssyDoc.AllReferencedDocuments).
3. Filter references to documents that are from given folder (e.g., "O:\04 R&D\08 beCAD 2013\03 PARTS\"). This also can be done using iProperties, parameters, attributes, etc.
4. For each document we can get all dependent components in main assembly (ComponentOccurrences.AllReferencedOccurrences(Document))
4. For each found occurrence we are able to find its graphics in our base view (if any exists) and if DrawingCurveSegments are found add them to SelectSet.
5. Change color and line style of all DrawingCurveSegments in SelectSet.
Hello,
I've looked into this but in the 4th step you will add lines to an selection set and not parts. By doing this you cannot emulate the button "hidden lines" in the RB menu. because online the visible lines of the parts will be colourd, not the invisble.
I see 2 options:
A) selecting the parts left in the browser and run the command of hidden lines (oControlDef ...)
B)
Option A) looks simple to me, but I have no idea how to get them using VBA
Option B) is more programming but see below my try, I can't get it to work but maybe it will work with some help
Public Sub AutoColor() 'step 1. select a drawingview ' Get the active drawing document. Dim oDrawDoc As DrawingDocument Set oDrawDoc = ThisApplication.ActiveDocument ' Have the user select a drawing view. Dim oDrawView As DrawingView Set oDrawView = ThisApplication.CommandManager.Pick(kDrawingViewFilter, "Select a drawing view.") Dim oDocDesc As DocumentDescriptor Set oDocDesc = oDrawView.ReferencedDocumentDescriptor ' Verify that the selected drawing view is of an assembly. If oDocDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then MsgBox "The selected view must be of an assembly." Exit Sub End If 'step 2. set it to hiddenlines 'Call oDrawView.SetDesignViewRepresentation(kHiddenLineDrawingViewStyle, True) '>>> error <<<< 'step 3. fill al drawingcurves in a ObjectCollection ' Get the TransientsObjects object Dim transObjs As TransientObjects Set transObjs = ThisApplication.TransientObjects ' create an Collection for Parts Dim objCollParts As ObjectCollection Set objCollParts = transObjs.CreateObjectCollection() 'get the assembly Dim oAssyDoc As AssemblyComponentDefinition Set oAssyDoc = oDocDesc.ReferencedDocument.ComponentDefinition 'call the function that adds the Part segments to the Collection Call SelectOccParts(oDrawView, oAssyDoc.Occurrences) 'step 4. Change the layer of the curves in the Collection 'Call oDrawView.Parent.ChangeLayer(objCollParts, <<<< a layer schould be here but I can't get it to work>>>>>) End Sub Private Sub SelectOccParts(drawView As DrawingView, Occurrences As ComponentOccurrences) ' Iterate through the current collection of occurrences. Dim occ As ComponentOccurrence For Each occ In Occurrences ' Check to see if this occurrence is a part or assembly. If occ.DefinitionDocumentType = kPartDocumentObject Then ' It's a part ' check if the occurence is the folder "03 PARTS", if it is then proces, else ignore ' the file location should be adjusted so it suits your files Dim OccFullLocation As String OccFullLocation = occ.ReferencedDocumentDescriptor.FullDocumentName If Left(OccFullLocation, 33) = "O:\04 R&D\08 beCAD 2013\03 PARTS\" Then MsgBox OccFullLocation 'add the segments to a collection On Error Resume Next Dim drawcurves As DrawingCurvesEnumerator Set drawcurves = drawView.DrawingCurves(occ) If Err.Number = 0 Then On Error GoTo 0 ' Add the curve segments to the collection. Dim drawCurve As DrawingCurve For Each drawCurve In drawcurves Dim segment As DrawingCurveSegment For Each segment In drawCurve.Segments 'objCollParts.Add segment '>>> error<<< Next Next End If On Error GoTo 0 End If Else ' It's an assembly so process its contents. Call SelectOccParts(drawView, occ.SubOccurrences) End If Next End Sub
The errors that I get and can't solve:
Thanks for the help!
Let's consider the follownig procedure. It finds all drawing curve segments projected from all occurrences of Cylinder.ipt part in all drawing views on the active sheet. Found graphics is moved to the new red colored layer "AAA".
Public Sub AutoColor_VA() 'step 1. select a drawingview Dim oDrawDoc As DrawingDocument Set oDrawDoc = ThisApplication.ActiveDocument Dim oSheet As Sheet Set oSheet = oDrawDoc.ActiveSheet 'for objects to be moved to specified layer Dim oColl As ObjectCollection Set oColl = ThisApplication.TransientObjects.CreateObjectCollection '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ' select drawing views on active sheet '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Dim oDrawView As DrawingView ' Option 1: Have the user select a drawing view. ' Set oDrawView = ThisApplication.CommandManager _ .Pick(kDrawingViewFilter, "Select a drawing view.") ' Option 2: we may process all drawing views on active sheet For Each oDrawView In oSheet.DrawingViews 'adjust drawing view style oDrawView.ViewStyle = DrawingViewStyleEnum.kHiddenLineDrawingViewStyle 'step 2. 'Get the active drawing document. Dim oDocDesc As DocumentDescriptor Set oDocDesc = oDrawView.ReferencedDocumentDescriptor ' Verify that the selected drawing view is of an assembly. If oDocDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then MsgBox "The selected view must be of an assembly." Exit Sub End If Dim oAssyDoc As AssemblyDocument Set oAssyDoc = oDocDesc.ReferencedDocument 'step 3 'filter required docs Dim oRefDocs As DocumentsEnumerator Set oRefDocs = oAssyDoc.AllReferencedDocuments Dim oDoc As Inventor.Document For Each oDoc In oRefDocs 'Criteria depends on your requirements: 'substring from filename, custom iProperty value, parameter value, etc. If InStr(oDoc.FullFileName, "Cylinder") > 0 Then 'this is required document Debug.Print oDoc.FullFileName 'debug print only 'find all occurrences for every part found Dim oOccEnum As ComponentOccurrencesEnumerator Set oOccEnum = oAssyDoc.ComponentDefinition.Occurrences _ .AllReferencedOccurrences(oDoc) Dim oOcc As ComponentOccurrence For Each oOcc In oOccEnum Dim oCurveUnum As DrawingCurvesEnumerator Set oCurveUnum = oDrawView.DrawingCurves(oOcc) Dim oCurve As DrawingCurve Dim oSegment As DrawingCurveSegment 'add segments to collection to be moved to required layer For Each oCurve In oCurveUnum For Each oSegment In oCurve.Segments Call oColl.Add(oSegment) Next Next Next 'oOcc End If Next 'oDoc Next 'oDrawView 'step 4. 'move found curves to desired layer 'create layer (if it doesn't exist), set color and styles Dim oLayer As Layer On Error Resume Next Set oLayer = oDrawDoc.StylesManager.Layers.Item("AAA") If Err Then Set oLayer = oDrawDoc.StylesManager.Layers _ .Item("Sketch Geometry (ANSI)").Copy("AAA") 'define color Dim oColor As Color Set oColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0) oLayer.Color = oColor 'define style 'oLayer.LineType = kDashedLineType End If 'change layer for curves collection Call oSheet.ChangeLayer(oColl, oLayer) oSheet.Update End Sub 'AutoColor_VA
I didn't test it much but hope this code can help you to solve your problem.
Cheers,
Hi VLadmir,
your code seems to do the trick on a efficiënt method!
really really thanks for this.
I'm now tweaking it to integrate into or processes. I'm now still searching for a method to get rid of the hidden lines of the frames. I can do this by making the hiddenlines invisible inside the layers and storing this inside the template.
Do you think there are other methods to do this? Maybe using VBA?
Thx,
Chris
Nice to get good new from you.
Please mark this case as solved.
With regard to hidden lines see Layer object functionality.
You can adjust its properties via Inventor API.
Have a good weekend 🙂
Cheers,
I can't put this code in the ilogic part of the idw. Is it possible to adjust this code so it works in ilogic?
Is it possible to get a text window where you can type in the partname you need, or it would be better if I could chose it out of a multi value list? And is it possible to chose the layer out of a multi value list?
And is it also possible to chose the discription instead of the filename?
Hi is it possible to make similar macro but for multisolid.ipt drawings where user can make only certain solid lines red (filtered by SOLID name)?
@Anonymous wrote:
I'm now still searching for a method to get rid of the hidden lines of the frames. I can do this by making the hiddenlines invisible inside the layers and storing this inside the template.
Do you think there are other methods to do this? Maybe using VBA?
Not sure if this will help, but drawing curve segments have a 'hidden line' property. If this property is true, it means the curve segment is drawn using the hidden drawing / line style. Here's a snippet from a VBA macro of mine:
'Add only the visible drawing curve segments to the collection.
If oDrawCurveSegment.HiddenLine = False Then
colSegmentsToColor.Add oDrawCurveSegment
End If
/Oops, didn't see the date on the specific post. Way too late.
instead of
oDrawView.ViewStyle = DrawingViewStyleEnum.kHiddenLineDrawingViewStyle
use
oDrawView.ViewStyle = DrawingViewStyleEnum.kHiddenLineRemovedDrawingViewStyle