iLogic "copy object"

[robertast]

When using the code for "copy object"

  ' Copy objekt
    oFeatureDef2.BRepEntities = oCollection2
    oFeatureDef2.OutputType = kSurfaceOutputType
    oFeatureDef2.TargetOccurrence = oOccurrence1          
    oFeatureDef2.IsAssociative = True  
	
    Dim oBaseFeature1 As NonParametricBaseFeature
    oBaseFeature1 = oPartDef1.Features.NonParametricBaseFeatures.AddByDefinition(oFeatureDef2)

Although an associative link is indicated, the element does not fall into place. It can be replaced by using the command

oAssemblyDoc.Update10(True)

But after that, it will not be possible to continue writing illogics. Tell me which team to put them in place in this place so that I can continue to work with this rule

[JhoelForshav · Accepted solution]

Hi @robertast 

Since you sent me a private message asking for a VBA version of this code i thought I'd post it here rather than replying with a private message. Just in case anyone else is interested in it 🙂

In order to make it work with the dictionary solution we did in iLogic, we must add a reference to "Microsoft Scripting Runtime" in VBA.

Tools->References...

I had to rewrite the code a little since this type of dictionary couldn't handle an Array as Key, but I made it work.

Here's the VBA code:

Sub CopyHoles()
Dim asmDoc As AssemblyDocument
Set asmDoc = ThisApplication.ActiveDocument
Dim asmDef As AssemblyComponentDefinition
Set asmDef = asmDoc.ComponentDefinition

Dim targetOcc As ComponentOccurrence
Set targetOcc = ThisApplication.CommandManager.Pick(kAssemblyLeafOccurrenceFilter, "Select Part to copy the Body into.")
Dim targetDef As PartComponentDefinition
Set targetDef = targetOcc.Definition
Dim nonPrmFeatures As NonParametricBaseFeatures
Set nonPrmFeatures = targetDef.Features.NonParametricBaseFeatures

Dim transObjs As TransientObjects
Set transObjs = ThisApplication.TransientObjects
Dim col As ObjectCollection
Set col = transObjs.CreateObjectCollection
Dim oHoles As Scripting.Dictionary
Set oHoles = CreateObject("Scripting.Dictionary")

Dim SourceOcc As ComponentOccurrence
Set SourceOcc = ThisApplication.CommandManager.Pick(kAssemblyLeafOccurrenceFilter, "Select Part to copy bodies from")

Dim oFace As FaceProxy
Set oFace = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kPartFacePlanarFilter, "Pick face.")
If oFace.ContainingOccurrence Is targetOcc = False Then
    MsgBox ("Face must be on the occurrence to copy bodies into")
    Exit Sub
End If
Dim oFirstSketch As PlanarSketch
Set oFirstSketch = targetDef.Sketches.Add(oFace.NativeObject) 'Something to find the face with after update
Dim oBod As SurfaceBody
For Each oBod In SourceOcc.Definition.SurfaceBodies
    If InStr(1, oBod.Name, "Hole") = 1 Then
        Dim oProx As SurfaceBodyProxy
        Call SourceOcc.CreateGeometryProxy(oBod, oProx)
        Dim intersects As Boolean
        intersects = False
        Dim oFprox As FaceProxy
        For Each oFprox In oProx.Faces
            If ThisApplication.MeasureTools.GetMinimumDistance(oFprox, oFace) = 0 Then
                intersects = True
                Exit For
            End If
        Next
        If intersects = True Then
            col.Add oProx
            Dim featureDef As NonParametricBaseFeatureDefinition
            Set featureDef = nonPrmFeatures.CreateDefinition
            featureDef.BRepEntities = col
            featureDef.OutputType = kSurfaceOutputType
            featureDef.TargetOccurrence = targetOcc
            featureDef.IsAssociative = True

            Dim baseFeature As NonParametricBaseFeature
            Set baseFeature = nonPrmFeatures.AddByDefinition(featureDef)
            Call ThisApplication.UserInterfaceManager.DoEvents
            On Error Resume Next
            baseFeature.Name = oBod.Name & " [" & SourceOcc.Name & "]"
            col.Clear
            Dim oVals() As String
            oVals = Split(oBod.Name, "(")
            oVals = Split(oVals(1), ")")
            Call oHoles.Add(CStr(oHoles.Count + 1) & "¤" & oVals(0), baseFeature)
        End If
    End If
Next
asmDoc.Update
Dim oKey As Variant
For Each oKey In oHoles
    Dim oSketch As PlanarSketch
    Set oSketch = targetDef.Sketches.Add(oFirstSketch.PlanarEntity)
    Dim oCol As ObjectCollection
    Set oCol = ThisApplication.TransientObjects.CreateObjectCollection

    Dim oProjEnt As SketchEntity
    Dim NPFface As Face
    For Each NPFface In oHoles(oKey).Faces
        If NPFface.SurfaceType = SurfaceTypeEnum.kCylinderSurface Then
            Set oProjEnt = oSketch.AddByProjectingEntity(NPFface.Edges(1))
            oProjEnt.Construction = True
            Dim oPt As SketchPoint
            Set oPt = oProjEnt.CenterSketchPoint
            oPt.HoleCenter = True
            oCol.Add oPt
        End If
    Next
    Dim oHole As HoleFeature
    Set oHole = targetDef.Features.HoleFeatures.AddDrilledByDistanceExtent(oCol, Split(Split(oKey, "¤")(1), ";")(0) / 10, Split(Split(oKey, "¤")(1), ";")(1) / 10, PartFeatureExtentDirectionEnum.kPositiveExtentDirection)
    If oHole.RangeBox Is Nothing Then
        oHole.Delete
        oHoles(oKey).Delete
    End If
Next
oFirstSketch.Delete
asmDoc.Update
End Sub

[robertast]

Yes, of course it will help others as well as all your posts. Thank! 👍