Hier ist noch der ganze Code, mit Allem drum und dran:

Code:

---

Option Explicit

' ******************************************************************************
' Macro written on 10/27/09 by fuerer_g
' ******************************************************************************

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swcomponent As SldWorks.Component2
Dim swSelMgr As SldWorks.SelectionMgr

Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long, status As Long
Dim PartName As String
Dim BGName As String

Dim matefeature As SldWorks.Feature

Sub Main()

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel
   
    'Baugruppen Name auslesen
    BGName = swModel.GetTitle
       
    'Starte die "Einfügen von eines virtuellen Komponenten" Sub
    Call InsertNewVIrtualPart("ich_Teil_du_nix")
       
    'Fixierung aufheben
    boolstatus = swModel.Extension.SelectByID2(PartName & "@" & BGName, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
    swModel.UnfixComponent
     
    'Baugruppe bearbeiten
    swModel.EditAssembly
   
    'XYZ Ebenen in einen Array speichern
    Dim Plane(3) As String
    Plane(1) = "X": Plane(2) = "Y": Plane(3) = "Z"
     
    Dim i As Integer
   
    'Alle drei Ebenen der Baugruppe (XYZ) mit dem entsprechenden Ebenen (XYZ) der virtuellen Komponenten mit Abstand Null verknüpfen
    For i = 1 To 3
        boolstatus = swModel.Extension.SelectByID2(Plane(i) + "@" + PartName + "@" + BGName, "PLANE", 0, 0, 0, False, 0, Nothing, 0)
        boolstatus = swModel.Extension.SelectByID2(Plane(i), "PLANE", 0, 0, 0, True, 0, Nothing, 0)
       

        '##########################################
        ' Das hier geht bei mir NICHT:       
        Set matefeature = swModel.AddMate3(swMateDISTANCE, swMateAlignCLOSEST, False, 0, 0, 0, 1, 1, 0, 0.5235987755983, 0.5235987755983, False, longstatus)
        'Debug.Print matefeature.Name
       
        'matefeature.Name = PartName + "_" + BGName + "_" & i & "_" & Int((5000000 + 1) * Rnd)
        '##########################################

        'boolstatus = swModel.Extension.SelectByID2("Abstand49", "MATE", 0, 0, 0, False, 0, Nothing, 0)
        'boolstatus = swModel.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, "Abstand 0")

        swModel.ClearSelection2 True
    Next
   
    boolstatus = swModel.ForceRebuild3(True)
    swModel.ClearSelection2 True

End Sub

Sub InsertNewVIrtualPart(NVCName)
         
    ' Get the pre-selected planar face
    Dim swFeature As SldWorks.Face2
    Set swSelMgr = swModel.SelectionManager
    Set swFeature = swSelMgr.GetSelectedObject6(1, 0)
   
    ' Create the part and insert it as a virtual component in the assembly
    status = swAssy.InsertNewVIrtualPart(swFeature, swcomponent)
   
    If status = 1 Then
        swcomponent.Name2 = NVCName
        PartName = swcomponent.Name2
    Else
        Debug.Print "Error code returned when attempting to insert new part as virtual component: " & status
    End If
   
    swModel.ClearSelection2 (True)

End Sub

---

------------------
 
http://www.worldcommunitygrid.org

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP