AddInsertConstraint

[mario170979]

Hello,

at first i have not so much experience in programming that why here in this case i have no idea. We use from a previous colleagues a script which has the function: in a assembly we have different parts a: tubes b: ubends. the you select a ubend and than the edges of 2 tubes and you get 2 constraints. helpful is that a copy of the ubend is placed. 

But now we have to constrain in the same assembly simple tubes too. Which takes by hand a lot time. 

maybe somebody has a idea how to get a script which works like the actual but for 1 constraint only (circular to circular) with benefit that we have a loop like in the actual script. 

our actual code: 

Sub Main()

Dim Uname As String
Uname = "B_"

Dim ConstraintDirection As String
ConstraintDirection = "True"

Dim nx, ny, nz, ox, oy, oz As Double
Dim oAsmDoc As AssemblyDocument
oAsmDoc = ThisApplication.ActiveDocument
Dim oAsmCompDef As AssemblyComponentDefinition
oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
Dim oTG As TransientGeometry
oTG = ThisApplication.TransientGeometry
Dim oMatrix As Matrix
oMatrix = oTG.CreateMatrix
Dim oCommandMgr As CommandManager
oCommandMgr = ThisApplication.CommandManager

Dim oBody As SurfaceBody
1:
oBody = ThisApplication.CommandManager.Pick(kPartBodyFilter, "Pick U-Bend")
  
  If oBody Is Nothing Then
     Exit Sub
  End If
  
   If Left(oBody.Parent.Name, 2) <> Uname Then
   
      GoTo 1
   End If

On Error Resume Next
Dim occ As ComponentOccurrence
occ = oAsmCompDef.Occurrences.ItemByName(oBody.Parent.Name)
If occ.Constraints.Count > 0 Then
'Debug.Print "Constrainted"
GoTo 1
End If
If Err.Number <> 0 Then
	Debug.Print(Err.Number, Err.Description)
'Original Code: Debug.Print Err.Number; Err.Description
     On Error GoTo 0
   '  MsgBox "Exit from procedure / ESC.."
     Exit Sub
End If

Dim part As PartDocument
part = ThisApplication.Documents.ItemByName(occ.ReferencedDocumentDescriptor.FullDocumentName)

'Debug.Print "Full Document Name: " & part.FullDocumentName & vbCrLf & "Document Name: " & part.DisplayName
 
 Dim oPath As String
 oPath = part.FullDocumentName
 

    Dim oTransform As Matrix
    oTransform = occ.Transformation
    
    Dim oOrigin As Point
    Dim oXAxis As Vector
    Dim oYAxis As Vector
    Dim oZAxis As Vector
    Call oTransform.GetCoordinateSystem(oOrigin, oXAxis, oYAxis, oZAxis)
    
    Dim vZ As Vector
    Dim vX As Vector
    Dim vY As Vector
     
    
    vX = oTG.CreateVector(1, 0, 0)
    vY = oTG.CreateVector(0, 1, 0)
    vZ = oTG.CreateVector(0, 0, 1)
    
    Dim oUOM As Inventor.UnitsOfMeasure
    oUOM = oAsmCompDef.Parent.UnitsOfMeasure
    
    nx = oOrigin.X
    ny = oOrigin.Y
    nz = oOrigin.Z

Do
    Call oMatrix.SetTranslation(oTG.CreateVector(nx, ny, nz))



Dim f As Edge
Dim fp As EdgeProxy

Dim oc As ObjectCollection
oc = ThisApplication.TransientObjects.CreateObjectCollection


    For Each f In occ.SurfaceBodies.Item(1).ConvexEdges
        Call occ.CreateGeometryProxy(f, fp)
        oc.Add (fp)
    Next
   Dim iOcCount As Long
   iOcCount = oc.Count
   
   Dim oEdge1 As Edge
   Dim oEdge2 As Edge
   Dim oEdge3 As Edge
   Dim oEdge4 As Edge
   
  oEdge1 = oc(1)
  oEdge2 = oc(iOcCount)
  

   oEdge3 = ThisApplication.CommandManager.Pick(kPartEdgeCircularFilter, "Select the Circular Edge 1.")
   oEdge4 = ThisApplication.CommandManager.Pick(kPartEdgeCircularFilter, "Select the Circular Edge 2.")


    Dim oInsert As InsertConstraint
    On Error Resume Next
    oInsert = oAsmCompDef.Constraints.AddInsertConstraint(oEdge1, oEdge3, ConstraintDirection, 0)
     If Err.Number <> 0 Then
     On Error GoTo 0
     Exit Sub
    End If
     On Error Resume Next
     oInsert = oAsmCompDef.Constraints.AddInsertConstraint(oEdge2, oEdge4, ConstraintDirection, 0)
        
    If Err.Number <> 0 Then
     On Error GoTo 0
     Exit Sub
    End If
    If oInsert.HealthStatus = 11786 Then
            If occ.Constraints.Count > 0 Then
              occ.Delete
           End If
    End If
    
    
 occ = oAsmCompDef.Occurrences.Add(oPath, oMatrix) 'Place part

ThisApplication.ActiveDocument.Rebuild
Loop


End Sub

[JelteDeJong]

Hi is this what you need?

Dim ConstraintDirection As String = "True"

Dim nx, ny, nz, ox, oy, oz As Double
Dim oAsmDoc As AssemblyDocument = ThisApplication.ActiveDocument
Dim oAsmCompDef As AssemblyComponentDefinition = ThisApplication.ActiveDocument.ComponentDefinition
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
Dim oMatrix As Matrix = oTG.CreateMatrix
Dim oCommandMgr As CommandManager = ThisApplication.CommandManager

Dim oBody As SurfaceBody = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartBodyFilter, "Pick U-Bend")

If oBody Is Nothing Then Exit Sub

Dim occ As ComponentOccurrence = Nothing
Try
    occ = oAsmCompDef.Occurrences.ItemByName(oBody.Parent.Name)
Catch ex As Exception
    Exit Sub
End Try

Dim part As PartDocument = ThisApplication.Documents.ItemByName(occ.ReferencedDocumentDescriptor.FullDocumentName)
Dim oPath As String = part.FullDocumentName
Dim oTransform As Matrix = occ.Transformation
Dim oOrigin As Point
Dim oXAxis As Vector
Dim oYAxis As Vector
Dim oZAxis As Vector
Call oTransform.GetCoordinateSystem(oOrigin, oXAxis, oYAxis, oZAxis)

Dim vZ As Vector = oTG.CreateVector(1, 0, 0)
Dim vX As Vector = oTG.CreateVector(0, 1, 0)
Dim vY As Vector = oTG.CreateVector(0, 0, 1)
Dim oUOM As Inventor.UnitsOfMeasure
oUOM = oAsmCompDef.Parent.UnitsOfMeasure

nx = oOrigin.X
ny = oOrigin.Y
nz = oOrigin.Z

Do
    Call oMatrix.SetTranslation(oTG.CreateVector(nx, ny, nz))
    Dim oc As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
    For Each f As Edge In occ.SurfaceBodies.Item(1).ConvexEdges
        Dim fp As EdgeProxy
        Call occ.CreateGeometryProxy(f, fp)
        oc.Add(fp)
    Next
    Dim iOcCount As Long = oc.Count
    Dim oEdge1 As Edge = oc(1)
    Dim oEdge2 As Edge = oc(iOcCount)
    Dim oEdge3 As Edge = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartEdgeCircularFilter, "Select the Circular Edge.")
    Dim oInsert As InsertConstraint
    Try
        oInsert = oAsmCompDef.Constraints.AddInsertConstraint(oEdge1, oEdge3, ConstraintDirection, 0)
    Catch ex As Exception
        Exit Sub
    End Try
    If oInsert.HealthStatus = 11786 Then
        If occ.Constraints.Count > 0 Then
            occ.Delete()
        End If
    End If
    occ = oAsmCompDef.Occurrences.Add(oPath, oMatrix) 'Place part
    ThisApplication.ActiveDocument.Rebuild()
Loop

[mario170979]

Hello Jelte,

thanks at first. yes it work. but i found out that with our model we get the  wrong edges constraint. Is it possible to modificate it so that i can select on the first part the edge which should constraint? 

In the picture: 

Blue is the edge i need and and a other  is selected. Otherwise we had to modificate some hundred old models to fix this.