Manufacturing DevBlog

Change icon of native browser node

By Adam Nagy

Changing the icon of a native browser node is similar to setting the icon of your own panel's client node, but you work with NativeBrowserNodeDefinition and set the OverrideIcon property instead.

Sub ChangeIcon()
    Dim bps As BrowserPanes
    Set bps = ThisApplication.ActiveDocument.BrowserPanes

    ' e.g. if you want to change the root node's icon
    ' in the assembly "Model" panel
    Dim bp As BrowserPane
    Set bp = bps("AmBrowserArrangement")
        
    Dim bmp As IPictureDisp
    Set bmp = LoadPicture("C:\Bitmap1.bmp")
        
    Dim cnr As ClientNodeResource
    ' Only Bitmaps are supported by the Add method
    ' and it should be 16x16
    Set cnr = bps.ClientNodeResources.Add( _
      "MyResource", 2, bmp)
      
    Dim nbnd As NativeBrowserNodeDefinition
    Set nbnd = bp.TopNode.BrowserNodeDefinition

    nbnd.OverrideIcon = cnr
End Sub

Add macros to quick access toolbar (QAT)

By Adam Nagy

If you want to add macros to the quick access toolbar then the following code should be useful.

It would also be possible to iterate through all the VBA macros and add them like that, but in this case we assume we already know the name of the macros we want to add.

Sub AddMacros() 
  ' List of Macros we want to add 
  Dim macros(1) As String 
  macros(0) = "Module2.qwe" 
  macros(1) = "Module1.test" 

  Dim cds As ControlDefinitions 
  Set cds = ThisApplication.CommandManager.ControlDefinitions 
  Dim ribbons As ribbons 
  Set ribbons = ThisApplication.UserInterfaceManager.ribbons 

  Dim macro As Variant 
  For Each macro In macros 
    ' Check if there is already a ControlDefinition for it 
    Dim cd As ControlDefinition 
    For Each cd In cds 
      If TypeOf cd Is MacroControlDefinition And _
        InStr(1, cd.InternalName, macro) > 0 Then 

        Exit For 
      End If 
    Next 

    ' Add it if not 
    If cd Is Nothing Then 
      Set cd = cds.AddMacroControlDefinition(macro)
    End If 

    Dim ribbon As ribbon 
    For Each ribbon In ribbons 
      ' Check if QAT already contains it 
      Dim cc As CommandControl 
      For Each cc In ribbon.QuickAccessControls 
        If cc.ControlDefinition Is cd Then 
          Exit For 
        End If 
      Next 

      ' Add it if not 
      If cc Is Nothing Then 
        Set cc = ribbon.QuickAccessControls.AddMacro(cd) 
      End If 
    Next 
  Next 
End Sub

minimum distance of cone face

By Xiaodong Liang

Issue
I uses GetMinimumDistance to get the distance from a cylinder to a cone face. If the cone has no tip (minor and major radius > 0), the distance looks correct. But if it has tip, the distance is no correct. It looks it chooses a random point on conical surface, instead of the tip point. e.g. as shown in the fig below. The attachment is a code reproduce it.

Public Sub GetMinDistance()

    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oDef As PartComponentDefinition
    
    Set oDef = oDoc.ComponentDefinition


    Dim oTransientBRep As TransientBRep
    Set oTransientBRep = ThisApplication.TransientBRep

    ' Create a point representing the center of the bottom of the cone
    Dim oBottom As Point
    Set oBottom = ThisApplication.TransientGeometry.CreatePoint(0, 0, 0)

    ' Create a point representing the tip of the cone
    Dim oTop As Point
    Set oTop = ThisApplication.TransientGeometry.CreatePoint(0, 2.54, 0)

    ' Create a transient cone body
    Dim oBody As SurfaceBody
    Set oBody = oTransientBRep.CreateSolidCylinderCone(oBottom, oTop, 5, 5, 2)

    ' Reset the top and bottom point of the cylinder
    Set oTop = ThisApplication.TransientGeometry.CreatePoint(0, 2.54 + 1.27, 0)
    Set oBottom = ThisApplication.TransientGeometry.CreatePoint(0, 2.54 + 1.27 + 2.54, 0)


    ' Create a transient cylinder body
    Dim oCylBody As SurfaceBody
    'Set oCylBody = oTransientBRep.CreateSolidCylinderCone(oBottom, oTop, 2.5, 2.5, 2.5)
    Set oCylBody = oTransientBRep.CreateSolidCylinderCone(oBottom, oTop, 2.5, 2.5, 0)
    
 
    ' Boolean the bodies; "oBody" will return the result
    Call oTransientBRep.DoBoolean(oBody, oCylBody, kBooleanTypeUnion)
    
    Dim oBaseFeature As NonParametricBaseFeature
    Set oBaseFeature = oDef.Features.NonParametricBaseFeatures.Add(oBody)
   
    
    Dim ocyl As Face
    Dim ocone As Face
    Dim f As Face
    
    For Each f In oBaseFeature.Faces
        If TypeOf f.Geometry Is Cone Then
            Set ocone = f
            Exit For
        End If
       
    Next
    
    For Each f In oBaseFeature.Faces
        If TypeOf f.Geometry Is Cone And (Not f Is ocone) Then
            Set ocyl = f
            Exit For
        End If
        
    Next
    
    Dim cont As NameValueMap
    Dim dist As Double
    
    ' The distance returned below is same as return By UI
    dist = ThisApplication.MeasureTools.GetMinimumDistance(ocone, ocyl, kNoInference, kNoInference, cont)
    
    Dim pt1 As Point
    Set pt1 = cont.Item(2)
    Dim pt2 As Point
    Set pt2 = cont.Item(3)
    
    oDef.WorkPoints.AddFixed pt1
    oDef.WorkPoints.AddFixed pt2
    
End Sub

Solution

Assume there are one cylinder and one cone (with tip).  The minimum distance between cylindrical face and cone with tip is calculated incorrectly as we have seen. But if we select planar face of cylinder and conical face then distance is shown correctly between tip and planar face.

If we create a 2D model bases on the 3D model like below figure.

The 2D model is created on a plane which is across the axis of the cone and cylinder, so now we can find that the minimum distance of the conical face and cylindrical face is the same of the minimum distance between the black line and the blue line. So create a line from the top end(red point) of the black line and perpendicular to the blue line like the picture shows, we will get the yellow line, the yellow line is the shortest one between the black line and blue line.

Actually this is affected by the apex angle of the cone(also the position of the cone tip), so like below if the apex angle of the cone is sharp enough that the yellow line has its perpendicular point on the extension of the blue line then the shortest line between the black line and the blue line would be like magenta line in below figure:

 

Constrain to the middle of an edge

By Adam Nagy

I'm trying to create a mate constraint between a work plane and the mid point of an edge, but I do not see how I could get back the middle vertex from the edge.

Solution

If you don't know how to do something through the API then a good starting point is to create the object through the user interface and then examine it through the API.
If you do that in this particular case then you'd see that EntityTwo of the MateConstraint is EdgeProxy and EntityTwoInferredType is kInferredPoint. If you create your mate constraint with that in mind then all should be fine:

Sub test()
    Dim asm As AssemblyDocument
    Set asm = ThisApplication.ActiveDocument
    
    ' Workplane from 1st occurrence
    Dim wp As WorkPlaneProxy
    Set wp = asm.SelectSet(1)
    
    ' Edge from 2nd occurrence
    Dim e As EdgeProxy
    Set e = asm.SelectSet(2)
    
    Dim acs As AssemblyConstraints
    Set acs = asm.ComponentDefinition.Constraints
    
    Dim mate As MateConstraint
    Set mate = acs.AddMateConstraint( _
      wp, e, 0, kNoInference, kInferredPoint)
End Sub

 

Using Inventor Properties from Apprentice Server

By Augusto Goncalves

Inventor documents have a set of properties (iProperties) associated with them and are organized into Property Sets, with related properties found in a given set. Each PropertySet is identified by its Display Name and an Internal Name and each of the Properties that it contains is in turn identified by its PropertyID and an optional Name. It is possible to create new PropertySets, which contain user defined properties in addition to the four predefined PropertySets. None of the Inventor created PropertySets can be deleted,but those that are created by third parties can be.

The DisplayNames of all the PropertySets can be changed. In addition to changing the names of the Properties their values can also be changed. In order to access a particular Property within a particular PropertySet (in order to change its Value or Name) one can do so directly instead of having to iterate through all the PropertySets.

The following examples (VB6, VB.NET and c++) show how to access a particular Propertycalled "Cost" within the PropertySet "Design Tracking Properties irectly using the PropertyID.The example also shows how to create new PropertySets/Properties and how to set/change valuesof properties. Using Apprentice Server all additions/changes to the PropertySets collection can be saved using the PropertySets.FlushToFile method instead of having to save the entire document.

Public Sub PropFromApprentice()

  ' Start Apprentice

  Dim newApp As ApprenticeServerComponent

  On Error Resume Next

  newApp = CreateObject("Inventor.ApprenticeServer")

  If newApp Is Nothing Then

    MsgBox("cannot start Apprentice")

    End

  End If

 

  Dim newDoc As ApprenticeServerDocument

 

  ' open the document

  newDoc = newApp.Open("C:\Temp\Part1_08.ipt")

  Dim propsets As PropertySets

  propsets = newDoc.PropertySets

 

  'Another way to access propertysets and properties

  Dim i As Integer

  For i = 1 To propsets.Count

    If propsets(i).DisplayName = _

      "Design Tracking Properties" Then

 

      Dim prop As Inventor.Property

      Dim j As Integer

      For j = 1 To propsets(i).Count

        prop = propsets(i).Item(j)

        If prop.Name = "Cost" Then

          prop.Value = "250"

        End If

      Next

    End If

  Next

 

  ' Accessing a particular property

  ' of a particular propertyset directly

  propsets.Item("Design Tracking Properties"). _

    ItemByPropId( _

      PropertiesForDesignTrackingPropertiesEnum. _

      kCostDesignTrackingProperties).Value = "300"

 

  ' you could also pass the Internal Name

  ' or the index as a parameter to the Item method.

  ' adding the new propertyset

  On Error Resume Next

  Dim NewPropertySet As PropertySet

  NewPropertySet = propsets.Item("DevTech Property Set")

 

  If (NewPropertySet Is Nothing) Then

    MsgBox("Adding new property set : DevTech Property Set")

    NewPropertySet = propsets.Add("DevTech Property Set")

  End If

 

  ' adding the new property to the property set

  Dim NewProperty As Inventor.Property

  NewProperty = NewPropertySet.Item("DevTech Property")

  If (NewProperty Is Nothing) Then

    Dim value As String

    Dim id As Integer

    value = "1"

    id = 15

    NewPropertySet.Add(value, "DevTech Property", id)

  Else

    NewProperty.value = "2"

  End If

 

  ' change the name of the new propertyset

  propsets.Item("DevTech Property Set"). _

    DisplayName = "New Property Set"

 

  ' change the value of the new property

  propsets.Item("DevTech Property Set"). _

    Item("DevTech Property").Value = "3"

 

  ' FlushToFile (only for Apprentice)

  propsets.FlushToFile()

 

End Sub

Override the Quantity of a BOM item

By Adam Nagy

I'm trying to override the Qty column of an McadBOMItem, but it does not work.
McadBOMItem.Quantity = 10 only seems to work if you first override the value through the user interface.

Solution

You need to make sure that AutoCalculateEnabled is set to False before trying to override it:

[CommandMethod("OverrideQuantity")]

public void OverrideQuantity()

{

  AcadApplication acadApp = (AcadApplication)
    Autodesk.AutoCAD.ApplicationServices.Application.AcadApplication;

 

  McadSymbolBBMgr symMgr =
    acadApp.GetInterfaceObject("SymBBAuto.McadSymbolBBMgr");

 

  McadBOMs symBOMs = symMgr.BOMMgr.GetAllBOMTables(true);

 

  foreach (McadBOM symBOM in symBOMs)

  {

    foreach (McadBOMItem symBOMItem in symBOM.get_Items(true))

    {

      symBOMItem.AutoCalculateEnabled = false;

      symBOMItem.Quantity = 20;

    }

  }

}

Revolve Feature that sweeps around a work axis

Q: Is there a way to create a RevolveFeature that sweeps a specified angle around a work axis?

A: Starting from Inventor 11 the parameter AxisEntity of the method AddByAngle allows applying a work axis as the axis of the revolution. AxisEntity is an input linear entity that defines the axis of the revolution. This can either be a sketch line in the same sketch that was used to generate the profile or a WorkAxis object.

The following VBA sample creates a revolve feature that sweeps the specified angle (2*Pi) around X base work axis.

Sub AddRevolveByAngleAndAxis()

 

  'Set a reference to the part document

  'This assumes a part document is active

  Dim oPartDoc As PartDocument

  Set oPartDoc = ThisApplication.ActiveDocument

  Dim oDef As PartComponentDefinition

  Set oDef = oPartDoc.ComponentDefinition

  Dim oTG As TransientGeometry

  Set oTG = ThisApplication.TransientGeometry

 

  'create new planar sketch on the plane XY

  Dim oPlane As WorkPlane

  Set oPlane = oDef.WorkPlanes.Item(3)

  Dim oSketch As PlanarSketch

  Set oSketch = oDef.Sketches.Add(oPlane)

 

  'circle center

  Dim oCenter As SketchPoint

  Set oCenter = oSketch.SketchPoints _

        .Add(oTG.CreatePoint2d(2, 2), False)

  'add sketch circle

  Dim oCircles As SketchCircles

  Set oCircles = oSketch.SketchCircles

  Dim oCircle As SketchCircle

  Set oCircle = oCircles.AddByCenterRadius(oCenter, 0.5)

 

  'revolve axis

  Dim oWorkAxis As Object

  Set oWorkAxis = oDef.WorkAxes.Item(1)

 

  'define angle value = 2*Pi

  Dim Angle As Variant

  Angle = 8 * Math.Atn(1)

 

  'add revolve feature

  Dim oProfile As Profile

  Set oProfile = oSketch.Profiles.AddForSolid

  Dim oRevFeature As RevolveFeature

  Set oRevFeature = oDef.Features.RevolveFeatures _

    .AddByAngle(oProfile, oWorkAxis, Angle, _

    PartFeatureExtentDirectionEnum.kNegativeExtentDirection, _

    PartFeatureOperationEnum.kJoinOperation)

     

  ThisApplication.ActiveView.Fit

  Beep

End Sub