Manufacturing DevBlog

Purge Appearances and Materials

By Adam Nagy

When you use an Asset, whether it's Material or Appearance, it gets copied into the document and can be accessed from the following properties of the Document object:
- AppearanceAssets
- MaterialAssets
- Assets (both Appearances and Materials)

If you want to get rid of unused items (i.e. purge the assets collection in the document) then you can just iterate through the items in the collections and remove the unused ones (where IsUsed = False).
Note: there might be connections between the assets in which case you have to iterate through them multiple times, until all the items stay used.

Sub PurgeMaterialsAndAppearances()
  Dim doc As PartDocument
  Set doc = ThisApplication.ActiveDocument
  
  ' There can be references between assets,
  ' so keep doing it until only used things remain
  Dim foundUnused As Boolean
  Do
    foundUnused = False
    Dim a As Asset
    For Each a In doc.Assets
      If Not a.IsUsed Then
        a.Delete
        foundUnused = True
      End If
    Next
  Loop While foundUnused
End Sub

This is what we start off with in the document and what we end up with after running the above code:

 

List painted area sizes

By Adam Nagy

If you want to find out how big the areas are in the assembly that need to be covered with certain paints then you can write a code to collect that data.

In this case to take into account any face colour that might have been overridden at the main assembly level, we'll iterate through all the faces in context of the top assembly. We just have to keep a list of all the materials we encountered, and the area they cover altogether. 

To help with this process I'm using a Dictionary object. In case of VBA you can use the one available from "Microsoft Scripting Runtime" library:

Other languages provide their own Dictionary implementation that you can use - e.g. .NET has it as well. 

For testing purposes I'm using the "Personal Computer.iam" sample that is available from the Autodesk Inventor 2016 Samples under "Models\Assemblies\Personal Computer":

Here is our code:

Sub CollectPaintedAreas()
  Dim doc As AssemblyDocument
  Set doc = ThisApplication.ActiveDocument
  
  Dim cd As AssemblyComponentDefinition
  Set cd = doc.ComponentDefinition
  
  ' This object type is from 
  ' "Microsoft Scripting Runtime" library
  Dim dict As Dictionary
  Set dict = New Dictionary
  
  ' Check all the faces for their appearance and area
  On Error Resume Next
  Dim co As ComponentOccurrence
  For Each co In cd.Occurrences.AllLeafOccurrences
    Dim sb As SurfaceBody
    For Each sb In co.SurfaceBodies
      Dim f As Face
      For Each f In sb.Faces
        Dim a As Asset
        Set a = f.Appearance
        ' Some faces might have issues with
        ' Appearance property
        If Err = 0 Then
          If dict.Exists(a.DisplayName) Then
            dict(a.DisplayName) = _
              dict(a.DisplayName) + f.Evaluator.Area
          Else
            Call dict.Add( _
              a.DisplayName, f.Evaluator.Area)
          End If
        End If
        Err.Clear
      Next
    Next
  Next
  
  ' If you also want to handle weldment assemblies and their weld beads 
  If TypeOf cd Is WeldmentComponentDefinition Then 
    Dim wcd As WeldmentComponentDefinition 
    Set wcd = cd Dim wbead As WeldBead 

    For Each wbead In wcd.Welds.WeldBeads 
      Dim fs As Faces 
      Set fs = wbead.BeadFaces 
      Set f = fs(fs.Count) 
      Set a = f.Appearance 
      ' Some faces might have issues with 
      ' Appearance property 
      If Err = 0 Then 
        If dict.Exists(a.DisplayName) Then 
          dict(a.DisplayName) = _ 
            dict(a.DisplayName) + f.Evaluator.area 
        Else 
          Call dict.Add( _ 
            a.DisplayName, f.Evaluator.area) 
        End If 
      Else 
        Const name = "Unknown" 
        If dict.Exists(name) Then 
          dict(name) = _ 
            dict(name) + f.Evaluator.area 
        Else 
          Call dict.Add( _ 
            name, f.Evaluator.area) 
        End If 
      End If 
      Err.Clear 
    Next 
  End If

  ' List result
  Dim n As Variant
  For Each n In dict
    Debug.Print n + " = " + Str(dict(n)) + " cm2"
  Next
End Sub

The result:

Silicon Nitride - Polished =  12916.9688783868 cm2
Glossy - Black =  2339.14399193464 cm2
Chrome - Polished =  3851.9558804525 cm2
Smooth - Ivory =  42.4976735204942 cm2
Clear - Green 1 =  1.40193572166445 cm2
Zinc =  777.846133032108 cm2
Cool White =  130.026627637732 cm2
Snow =  497.991799292123 cm2
Aluminum - Polished =  1798.11482682528 cm2
Copper - Polished =  23.2457401847515 cm2
Pink Rose =  1.94839840336866 cm2
Blue - Wall Paint - Glossy =  66.2601255359018 cm2
Violet =  2.30497698015977 cm2
Smooth - Dark Forest Green =  1746.5581771357 cm2
Green Pastel =  2.03418124319939 cm2
Pink =  2.03418124319939 cm2
Sky Blue Medium =  2.03418124319939 cm2
Smooth - Yellow =  30.2747833343406 cm2
Dark Gray =  289.6377248152 cm2
Light Gray =  86.5221761930381 cm2
Glossy - Gold =  1.89552392144668 cm2
Light Red =  29.8206048586813 cm2
Teflon =  23.5951135218548 cm2
Wheat =  13.1217919533048 cm2
Aluminum - Polished-1 =  2.91547594742265E-02 cm2
Default =  421.056440220586 cm2
Red =  57.6774842076835 cm2
Rubber-Black =  214.031238785277 cm2
White =  1.21634005726582 cm2
Light Beige =  2.96880505764235 cm2
Orange (Pale) =  6117.16485607271 cm2
Orange (Inventor) =  12.359525846104 cm2

If you want to do the same inside a part document, then you could do it like this:

Sub CollectPaintedAreasInPartDocument()
  Dim doc As PartDocument
  Set doc = ThisApplication.ActiveDocument
    
  Dim cd As PartComponentDefinition
  Set cd = doc.ComponentDefinition
    
  ' This object type is from
  ' "Microsoft Scripting Runtime" library
  Dim dict As Dictionary
  Set dict = New Dictionary
    
  ' Check all the faces for their appearance and area
  On Error Resume Next
  Dim sb As SurfaceBody
  For Each sb In cd.SurfaceBodies
    Dim f As Face
    For Each f In sb.Faces
      Dim a As Asset
      Set a = f.Appearance
      ' Some faces might have issues with
      ' Appearance property
      If Err = 0 Then
        If dict.Exists(a.DisplayName) Then
          dict(a.DisplayName) = _
            dict(a.DisplayName) + f.Evaluator.area
        Else
          Call dict.Add( _
            a.DisplayName, f.Evaluator.area)
        End If
      End If
      Err.Clear
    Next
  Next
    
  ' List result
  Dim n As Variant
  For Each n In dict
    Debug.Print n + " = " + Str(dict(n)) + " cm2"
  Next
End Sub

Get all faces and edges as NURBS

By Adam Nagy

Through the API it's possible to get back edges (lines, arcs, etc) and also the faces (plane, cylinder) as NURBS. You can use the AlternateBody property of the SurfaceBody object for this. Based on the parameters you provide either only the faces will be converted to NURBS or both the faces and edges.

Remarks in API Help file:

Valid values for the AlternateForm parameter are in the SurfaceGeometryFormEnum and are:
- SurfaceGeometryForm_NURBS: Convert analytic surfaces to NURBS. This may result in splitting faces and edges as necessary. When used alone, only the faces are converted to NURBS. Edges will be represented by analytic curves.
- SurfaceGeometryForm_ProceduralToNURBS: Convert procedural surfaces to more accurate NURB approximations. This may result in splitting faces and edges as necessary
- These are bitwise values and combining SurfaceGeometryForm_NURBS and SurfaceGeometryForm_ProceduralToNURBS will create a result where the entire body or face is converted to NURBS, procedural surfaces are accurately approximated, and all edges will also be converted to NURBS.

The following code shows how to get the various types of geometry from the model. In this case we are testing it with this cylinder body shown in the picture:

Sub PrintBodyInfo(sb As SurfaceBody)
  Dim fs As FaceShell
  For Each fs In sb.FaceShells
    Debug.Print Space(1); "FaceShell"
    Dim f As Face
    For Each f In fs.Faces
      Debug.Print Space(2); "Face: " + TypeName(f.Geometry)
      Dim el As EdgeLoop
      For Each el In f.EdgeLoops
        Debug.Print Space(3); "EdgeLoop"
        Dim e As Edge
        For Each e In el.Edges
          Debug.Print Space(4); "Edge: " + TypeName(e.Geometry)
        Next
      Next
    Next
  Next
End Sub

Sub GetBodies()
  Dim pd As PartDocument
  Set pd = ThisApplication.ActiveDocument
    
  Dim cd As PartComponentDefinition
  Set cd = pd.ComponentDefinition
     
  Debug.Print ">> Original geometry"
  Dim sb1 As SurfaceBody
  Set sb1 = cd.SurfaceBodies(1)
  Call PrintBodyInfo(sb1)
    
  Debug.Print ">> AlternateBody(SurfaceGeometryForm_NURBS)"
  Dim sb2 As SurfaceBody
  Set sb2 = sb1.AlternateBody(SurfaceGeometryForm_NURBS)
  Call PrintBodyInfo(sb2)

  Debug.Print ">> AlternateBody(SurfaceGeometryForm_NURBS " + _
    "Or SurfaceGeometryForm_ProceduralToNURBS)"
  Dim sb3 As SurfaceBody
  Set sb3 = sb1.AlternateBody(SurfaceGeometryForm_NURBS Or _
    SurfaceGeometryForm_ProceduralToNURBS)
  Call PrintBodyInfo(sb3)
End Sub

The result:

>> Original geometry
 FaceShell
  Face: Cylinder
   EdgeLoop
    Edge: Circle
   EdgeLoop
    Edge: Circle
  Face: Plane
   EdgeLoop
    Edge: Circle
  Face: Plane
   EdgeLoop
    Edge: Circle
>> AlternateBody(SurfaceGeometryForm_NURBS)
 FaceShell
  Face: BSplineSurface
   EdgeLoop
    Edge: LineSegment
    Edge: Arc3d
    Edge: LineSegment
    Edge: Arc3d
  Face: BSplineSurface
   EdgeLoop
    Edge: LineSegment
    Edge: Arc3d
    Edge: LineSegment
    Edge: Arc3d
  Face: BSplineSurface
   EdgeLoop
    Edge: Arc3d
    Edge: Arc3d
  Face: BSplineSurface
   EdgeLoop
    Edge: Arc3d
    Edge: Arc3d
>> AlternateBody(SurfaceGeometryForm_NURBS Or 
SurfaceGeometryForm_ProceduralToNURBS)
 FaceShell
  Face: BSplineSurface
   EdgeLoop
    Edge: BSplineCurve
    Edge: BSplineCurve
    Edge: BSplineCurve
  Face: BSplineSurface
   EdgeLoop
    Edge: BSplineCurve
  Face: BSplineSurface
   EdgeLoop
    Edge: BSplineCurve

DevDays and DevWeek

By Adam Nagy

DevDays is getting closer and closer. This time around it won't be just a one day event but will be combined with DevWeek where we will help developers create their solutions based on our technologies.

These events are not only for ADN members! Anyone interested in learning about what's coming in the next release of our products or needs our help with using our API's is welcome to join.

See you there! :)

http://autodeskdevdays.com

 

Get FullFileName of original AnyCAD component

By Adam Nagy

AnyCAD functionality enables you to include non-native file formats directly in your assembly.

For those files the FullDocumentName/FullFileName will be special because Inventor has proxy documents for those components:

FullDocumentName:**C:\Temp\AnyCAD\Workspaces\Workspace\AnyCADBase.iam*LocalDocs*xFu0c05ic1y3mu2kv3oevwllrOa*1000083398swa000.iam 
FullFileName:**C:\Temp\AnyCAD\Workspaces\Workspace\AnyCADBase.iam*LocalDocs*xFu0c05ic1y3mu2kv3oevwllrOa*1000083398swa000.iam 
--------------------------- 
FullDocumentName:**C:\Temp\AnyCAD\Workspaces\Workspace\AnyCADBase.iam*LocalDocs*xS5rzpyzj10cluts2Febybwr1Bg*1000082731swp000.ipt 
FullFileName:**C:\Temp\AnyCAD\Workspaces\Workspace\AnyCADBase.iam*LocalDocs*xS5rzpyzj10cluts2Febybwr1Bg*1000082731swp000.ipt 

If you need to find the original file which is being referenced then you need to look for it in the ImportedComponents collection:

Sub CheckAnyCADInAssembly()
    Dim doc As AssemblyDocument
    Set doc = ThisApplication.ActiveDocument
     
    Dim oImportComponent As ImportedComponent
    For Each oImportComponent In doc.ComponentDefinition.ImportedComponents
        If oImportComponent.LinkedToFile Then
            Debug.Print oImportComponent.Definition.FullFileName
        End If
    Next
End Sub

Output:

C:\Temp\AnyCAD\Workspaces\Workspace\1000083398swa000.sldasm

Although you can list all the non-native files that got imported (see below code), you can only find a direct connection between the top assembly that got imported and the original assembly it is referencing. There is no direct connection exposed in Inventor 2016 between the sub components / occurrences and the original part and assembly files that got imported:

Sub CheckAnyCADInAssembly()
  Dim doc As AssemblyDocument
  Set doc = ThisApplication.ActiveDocument

  Dim oDoc As File
  For Each oDoc In doc.File.AllReferencedFiles
    Debug.Print oDoc.FullFileName
  Next
End Sub

Sample output:

C:\Gears_&\frame_&.SLDPRT
C:\Gears_&\gears_&.SLDASM
C:\Gears_&\Internal Spur Gear_&.sldprt
C:\Gears_&\shaft1_&.SLDPRT
C:\Gears_&\shaft2_&.SLDPRT
C:\Gears_&\Spur Gear_&.sldprt

Sort the BOM in AutoCAD Mechanical

By Adam Nagy

In case of the UI of AutoCAD Mechanical there are three keys you can set for the sort:

Sorting based on keys is a UI only method. In the API you don't really need that since there you have full control over how the items should be sorted. You can come up with any sorting logic, it just needs to set the SortPriority property of each McadBOMItem before calling applySort().

The following VBA sample sorts based on the Item Number property of the BOM items:

Public Sub SortBom()
    Dim symMgr As McadSymbolBBMgr
    Set symMgr = ThisDrawing.Application. _
        GetInterfaceObject("SymBBAuto.McadSymbolBBMgr")

    Dim BOMs As McadBOMs
    Set BOMs = symMgr.bommgr.GetAllBOMTables(False)
    
    Dim BOM As McadBOM
    Set BOM = BOMs.item(0)
    
    Dim item As McadBOMItem
    For Each item In BOM.Items
        Dim p As Long: p = Val(item.ItemNumber)
        If p > 0 Then item.SortPriority = p
    Next
    
    BOM.applySort
End Sub

Note: the lower the SortPriority value the earlier (more top in the table) the item will appear in the list. Also its value does not have to be unique.

Face to PlanarSketch

By Adam Nagy

If you want to turn a Face into a PlanarSketch (e.g. in order to get RegionProperties for it) then the following should work.

Create a sketch based on the face, then project all the edges into it. Then you could create a Profile from it, which will of course have RegionProperties:

Sub SketchFromFace()
    ' Before running this code, select the face
    ' you want to create a sketch from
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
    
    Dim oFace As Face
    Set oFace = oDoc.SelectSet(1)
    
    Dim oDef As PartComponentDefinition
    Set oDef = oDoc.ComponentDefinition
    
    Dim oSketch As PlanarSketch
    Set oSketch = oDef.Sketches.Add(oFace)
    
    Dim oEdge As Edge
    For Each oEdge In oFace.Edges
        Call oSketch.AddByProjectingEntity(oEdge)
    Next
        
    Dim oProfile As Profile
    Set oProfile = oSketch.Profiles.AddForSolid()
    
    Debug.Print "Area = " + Str(oProfile.RegionProperties.Area)
End Sub

Code in action - just select the face you are interested in:

Additional code for printing RegionProperties data: 
http://adndevblog.typepad.com/manufacturing/2015/09/querying-a-sketch-profile-to-get-regions.html

Create a SweepFeature with Path

By Adam Nagy

Creating a Sweep Feature is usually quite straight forward. However, you can run into some issues - like the one I'm going to talk about now.

If you have two sketches, one used as the Profile (Sketch2) and one used as the Path (Sketch1), then if they are connected through a sketch point then the CreatePath() function will use all the entities from both sketches and your swept surface creation will fail. Here is the debug message from the below code:

Sketch2
-4.9;  3.29922145229642;  .15
-4.9; -3.29922145229644;  .15
Sketch1
-4.9; -3.29922145229644;  .15
-5.05; -3.29922145229644;  .15
Sketch1
-5.05; -3.29922145229644;  .15
-5.35; -3.29922145229644;  .45
Sketch1
-5.35; -3.29922145229644;  .45
-5.35; -3.29922145229644;  2.35

You'll find the same behaviour in the UI: if you're trying to select the entities for the Path first and click an entity in Sketch1, then not only the Sketch1 entities will be selected for the Path, but also the Sketch2 entity which is connected to a Sketch1 entity through a sketch point:

If I select the Profile first by clicking the Sketch2 entity, and then try to select the Path, then Inventor is clever enough not to use the Profile entity as part of the Path:

When doing things programmatically, we need to add a similar logic to our code: remove the Sketch2 entity from the Path. 

The easiest way to do that is to use CreatePath() to collect all the entities for the Path, then collect from that all the entities which are inside Sketch1. Then you can call CreateSpecifiedPath() to create a path that is using the provided entities and in the order they were provided. 
Note: CreateSpecifiedPath() seems to require you to pass the entities in the order you want to use them ensuring a continuous path, and providing them in the wrong order will make it fail: e.g. passing in Line1, Line3, Line2 will fail. That's why letting Inventor figure out the right order by using CreatePath() first seems to be the easiest solution.

Sub PrintPoint(p As Point)
    Debug.Print Str(p.X) + "; " + Str(p.Y) + "; " + Str(p.Z)
End Sub

Sub PrintPathInfo(p As Path)
    Dim pe As PathEntity
    For Each pe In p
        Debug.Print pe.SketchEntity.Parent.Name
        PrintPoint pe.Curve.StartPoint
        PrintPoint pe.Curve.EndPoint
    Next
End Sub

Sub CreateSweep()
    ' Before running this code select first Sketch1 and then 
    ' Sketch2 as well in the UI
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument

    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oDoc.ComponentDefinition
    
    Dim oSkPath As PlanarSketch
    Set oSkPath = oDoc.SelectSet(1)
    
    Dim oSkProfile As PlanarSketch
    Set oSkProfile = oDoc.SelectSet(2)
    
    ' Just to clean up after all the tests
    Do While oSkProfile.Profiles.Count > 0
        oSkProfile.Profiles(1).Delete
    Loop
      
    Dim oProfile As Profile
    Set oProfile = oSkProfile.Profiles.AddForSurface()
    
    Dim oPath As Path
    Set oPath = oCompDef.Features.CreatePath(oSkPath.SketchLines(1))
    
    ' This might contain entities from other sketches
    Debug.Print "Default Path"
    Call PrintPathInfo(oPath)
    
    ' Remove unnecessary lines from it
    Dim oTO As TransientObjects
    Set oTO = ThisApplication.TransientObjects
    
    Dim oColl As ObjectCollection
    Set oColl = oTO.CreateObjectCollection
    
    Dim oPathEntity As PathEntity
    For Each oPathEntity In oPath
        Dim oSkEntity As SketchEntity
        Set oSkEntity = oPathEntity.SketchEntity
        
        If oSkEntity.Parent Is oSkPath Then
            Call oColl.Add(oSkEntity)
        End If
    Next
    
    Dim oPathNew As Path
    Set oPathNew = oCompDef.Features.CreateSpecifiedPath(oColl)
    
    Debug.Print "New Path"
    Call PrintPathInfo(oPathNew)
     
    Dim oSweepDef As SweepDefinition
    Set oSweepDef = oCompDef.Features.SweepFeatures.CreateSweepDefinition( _
        kPathSweepType, oProfile, oPathNew, kSurfaceOperation)
  
    Dim oSweepOne As SweepFeature
    Set oSweepOne = oCompDef.Features.SweepFeatures.Add(oSweepDef)
End Sub

VBA Immediate Window with our debug strings:

Default Path
Sketch2
-4.9;  3.29922145229642;  .15
-4.9; -3.29922145229644;  .15
Sketch1
-4.9; -3.29922145229644;  .15
-5.05; -3.29922145229644;  .15
Sketch1
-5.05; -3.29922145229644;  .15
-5.35; -3.29922145229644;  .45
Sketch1
-5.35; -3.29922145229644;  .45
-5.35; -3.29922145229644;  2.35
New Path
Sketch1
-4.9; -3.29922145229644;  .15
-5.05; -3.29922145229644;  .15
Sketch1
-5.05; -3.29922145229644;  .15
-5.35; -3.29922145229644;  .45
Sketch1
-5.35; -3.29922145229644;  .45
-5.35; -3.29922145229644;  2.35

And the result:

 

Fusion 360 Hackathon - Command and UI

By Adam Nagy

Here is the recording of the Fusion 360 Hackathon presentation from Thursday. You can either download the file or watch it on youtube.

#Fusion360Hackathon

 

Fusion 360 Hackathon - Introduction to the Fusion object model

By Adam Nagy

Here is the recording of the Fusion 360 Hackathon presentation from Tuesday. You can either download the file or watch it on youtube.

#Fusion360Hackathon