vielleicht kann mir jemand bei meinem Problem helfen? Möchte folgendes VisualBasic Programm konvertieren.
Code: Alles auswählen
' aus Project-datei:
'Reference=*\G{649ABA85-187F-47DA-BA37-B5A3563B21DC}#1.0#0#..\..\..\..\..\..\..\Program Files\3D Systems\Cubify Design 2014\Program\AlibreX.tlb#Alibre Automation Type Library
'Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\Windows\system32\stdole2.tlb#OLE Automation
Option Explicit
Private hook As AlibreX.AutomationHook ' Holds Alibre Automation hook object
Private rootObj As IADRoot ' Holds Alibre Root object
Private objADOccurrence As IADOccurrence ' Holds Occurrence object
Private DesignSession As IADDesignSession ' Holds Alibre Design Session object
Private objPartSession As IADPartSession ' Holds Alibre Part Session object
Private objSession As IADSession ' Holds Alibre Session Object
'This function gets the automation hook for the running instance of Alibre.
'If there is any Assembly Session open, then the 'Insert part and Save Assembly' button gets enabled.
'If there is no Assembly Session open, this button remains disabled.
Private Sub Form_Load()
Dim strServerURL As String
Dim strUsername As String
Dim strPassword As String
Dim flag As Boolean
flag = True
strServerURL = " "
strUsername = " "
strPassword = " "
On Error Resume Next
'Gets the automation hook for the running instance of Alibre
Set hook = GetObject(, "AlibreX.AutomationHook")
If (hook Is Nothing) Then 'If Alibre Design is not initialized
AssemblyEdit.Enabled = False
Label1.Caption = "Open any Assembly in Alibre and restart this application"
Else 'If Alibre Design is initialized
Set rootObj = hook.Root
AssemblyEdit.Enabled = True
End If
End Sub
'This function inserts a part into the first Assembly Session and then Saves it to C:\ Drive
Private Sub AssemblyEdit_Click()
On Error GoTo Error_Trap
Dim objAssmSession As IADAssemblySession ' Holds Alibre Assembly Session Object
Dim objADRootOccurrence As IADOccurrence ' Holds Root Occurrence of the Assembly
Dim objADOccurrences As IADOccurrences ' Holds all Occurrences of the Assembly
Dim destinationString As String ' Holds the location where the File gets Saved
Dim flag As Boolean
flag = True
If (rootObj Is Nothing) Then 'Exit if for some reason an instance of Alibre Design could not be found
Exit Sub
End If
If (rootObj.Sessions Is Nothing) Then 'Exit if for some reason an Alibre Session Object could not be found
Exit Sub
End If
If (rootObj.Sessions.Count > 0) Then ' If there is atleast one workspace open
For Each objSession In rootObj.Sessions
If ((objSession.SessionType = ADObjectSubType_AD_ASSEMBLY) And (flag = True)) Then ' If there is atleast one Assembly open
Set objAssmSession = objSession ' part is inserted into that assembly
flag = False
Label1.Caption = "Inserting Part into the Assembly..."
' Set the Object Session to be the Assembly's session
Set objSession = objAssmSession
' Get Root Occurrence from Assembly Session
Set objADRootOccurrence = objAssmSession.RootOccurrence()
' Get Occurrences collection from Root Occurance
Set objADOccurrences = objADRootOccurrence.Occurrences()
' Holds Geometry Factory
Dim objADGeometryFactory As IADGeometryFactory
' Get Geometry Factory from Session object
Set objADGeometryFactory = objSession.GeometryFactory
' Holds Transformation Array Data
Dim adblTransformationArrayData(15) As Double
' Populate the Transformation Array with the following Data for Back View
' 1 0 0 0
' 0 1 0 0
' 0 0 1 0
' 0 0 0 1
adblTransformationArrayData(0) = 1
adblTransformationArrayData(1) = 0
adblTransformationArrayData(2) = 0
adblTransformationArrayData(3) = 0
adblTransformationArrayData(4) = 0
adblTransformationArrayData(5) = 1
adblTransformationArrayData(6) = 0
adblTransformationArrayData(7) = 0
adblTransformationArrayData(8) = 0
adblTransformationArrayData(9) = 0
adblTransformationArrayData(10) = 1
adblTransformationArrayData(11) = 0
adblTransformationArrayData(12) = 0
adblTransformationArrayData(13) = 0
adblTransformationArrayData(14) = 0
adblTransformationArrayData(15) = 1
' Holds Transformation
Dim objADTransformation As AlibreX.IADTransformation
' Create Transformation
Set objADTransformation = objADGeometryFactory.CreateTransform(adblTransformationArrayData())
' Add an Empty Part as Occurrence
Set objADOccurrence = objADOccurrences.AddEmptyPart("BlockMitLoch", False, objADTransformation)
' Set Design Session to be the empty Part's Design Session that was just added to the assembly
Set DesignSession = objADOccurrence.DesignSession
' Set Part Session to be the empty Part's Design Session that was just added to the assembly
Set objPartSession = DesignSession
' Call to CreateFeatures method to add features to the empty part inserted into the assembly
CreateFeatures
Label1.Caption = "Part inserted successfully into " & objSession.Name
'Saves the Assembly with the Part to the location specified
Label1.Caption = "Saving assembly on C:\ Drive..."
destinationString = "C://"
Call objSession.SaveAs(destinationString, objSession.Name)
Label1.Caption = "Assembly is saved successfully on C:\"
AssemblyEdit.Enabled = False
GoTo Error_Trap
Else
Label1.Caption = "Please open any Assembly"
End If
Next
Else 'If there is no assembly open
Label1.Caption = "Please open any Assembly"
End If
Error_Trap:
'Handle Errors here
Exit Sub
End Sub
'This Function creates a Block with a Hole in the empty part that is added to the main Assembly
Private Sub CreateFeatures()
Dim allPlanes As IADDesignPlanes ' Holds Design Planes
Dim refPlane As IADDesignPlane ' Holds Design Plane
Dim objPlaneSketch As IADSketch ' Holds the Reference Sketch
Dim objADSketchFigures As IADSketchFigures ' Holds all Sketch Figures
Dim objFeatures As IADPartFeatures ' Holds all Part Features
Dim objExtrudeBossFeature As IADPartFeature ' Holds the Extrusion Feature
Set allPlanes = DesignSession.DesignPlanes ' Get all Planes in the Part
Set refPlane = allPlanes.Item("XY-Ebene") ' Get XY Plane
Set objPlaneSketch = objPartSession.Sketches.AddSketch(Nothing, refPlane, "Sketch1") 'Add Sketch to XY Plane
Set objADSketchFigures = objPlaneSketch.Figures 'Get the Sketch added to XY Plane
'The following calls sketch a Rectangle and a Circle in the XY Plane
Call objPlaneSketch.BeginChange
Call objPlaneSketch.Figures.AddRectangle(-10, -10, 10, 10)
Call objPlaneSketch.Figures.AddCircle(0, 0, 5)
Call objPlaneSketch.EndChange
Set objPlaneSketch = objPartSession.Sketches("Sketch1") ' Name the Sketch as Sketch1
Set objFeatures = objPartSession.Features
'Adds the Extrusion feature using the Sketch created above
Set objExtrudeBossFeature = objFeatures.AddExtrudedBoss(objPlaneSketch, 5#, _
ADPartFeatureEndCondition_AD_MID_PLANE, Nothing, Nothing, _
0, ADDirectionType_AD_ALONG_NORMAL, Nothing, _
Nothing, False, 0#, False, "BlockMitLochFeature")
End Sub
Private Sub CloseCommand_Click()
If rootObj Is Nothing Then
Unload Me
Exit Sub
Else
Set rootObj = Nothing
Unload Me
End If
End Sub
Habe es mit Excel VBA probiert, Code funktioniert.
Auszug aus dem Objektkatalog (Excel VBA):
Code: Alles auswählen
Property Root As Object
schreibgeschützt
Element von AlibreX.AutomationHook
Returns the automation root
Property Sessions As IADSessions
schreibgeschützt
Element von AlibreX.IADRoot
Returns a collection of open design and drawing sessions
Property SessionType As ADObjectSubType
schreibgeschützt
Element von AlibreX.IADSession
Returns a pre-defined constant that identifies whether this session is a part or assembly or drawing session
Property Name As String
schreibgeschützt
Element von AlibreX.IADSession
Returns this session's name
Code: Alles auswählen
IncludePath "..\COMatePLUS"
XIncludeFile "COMatePlus.pbi"
EnableExplicit
Global.COMateObject hook, rootObj, objADOccurrence, DesignSession, objPartSession, objSession
#ADObjectSubType_AD_ASSEMBLY = 2
Enumeration
#frm_Main
#btn_AssemblyEdit
#btn_Close
#txt_Label1
EndEnumeration
Procedure ShowErrorIfAny(text.s)
If COMate_GetLastErrorCode()
Debug text + ":"
Debug COMate_GetLastErrorCode()
Debug COMate_GetLastErrorDescription() + #CRLF$
EndIf
EndProcedure
Procedure Form_Load()
OpenWindow(#frm_Main, 0, 0, 420, 220, "PartInsertAndAssemblySave", #PB_Window_SystemMenu)
ButtonGadget(#btn_AssemblyEdit, 95, 90, 230, 45, "Insert Part and Save Assembly")
ButtonGadget(#btn_Close, 150, 150, 115, 35, "CLOSE")
TextGadget(#txt_Label1, 65, 25, 300, 45, "")
hook = COMate_GetObject("", "alibreX.AutomationHook")
If hook = 0
DisableGadget(#btn_AssemblyEdit, 1)
SetGadgetText(#txt_Label1, "Open any Assembly in Alibre and restart this application")
Else
DisableGadget(#btn_AssemblyEdit, 0)
rootObj = hook\GetObjectProperty("Root")
EndIf
EndProcedure
Procedure AssemblyEdit_Click()
Define.COMateEnumObject DomENUMObject
Define.COMateObject NodeObject
If rootObj = 0 ; Exit if for some reason an instance of Alibre Design could not be found
Debug "Ups, Keine Alibre Instanz gefunden"
ProcedureReturn
EndIf
If Not rootObj\GetObjectProperty("Sessions") ; Exit if for some reason an Alibre Session Object could not be found
Debug "Ups, Keine Alibre Session gefunden"
ProcedureReturn
EndIf
If rootObj\GetIntegerProperty("Sessions\Count") = 0 ; If there is at least one workspace open
Debug"Ups, Keine Workspace offen"
ProcedureReturn
EndIf
DomENUMObject = rootObj\CreateEnumeration("Sessions") : ShowErrorIfAny("DomENUMObject")
If DomENUMObject
NodeObject = DomENUMObject\GetNextObject() : ShowErrorIfAny("NodeObject")
While NodeObject
Debug NodeObject\GetStringProperty("Name") : ShowErrorIfAny("StringProperty Name")
Debug NodeObject\GetObjectProperty("Name") : ShowErrorIfAny("ObjectProperty Name")
Debug NodeObject\GetIntegerProperty("SessionType") : ShowErrorIfAny("StringProperty SessionType")
Debug NodeObject\GetObjectProperty("SessionType") : ShowErrorIfAny("ObjectProperty SessionType")
NodeObject\Release() : ShowErrorIfAny("NodeRelease")
NodeObject = DomENUMObject\GetNextObject() : ShowErrorIfAny("NextObject")
Wend
DomENUMObject\Release()
Else
Debug "Kein DomEnumObject"
EndIf
EndProcedure
Form_Load()
Define event
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_Gadget
Select EventGadget()
Case #btn_AssemblyEdit
AssemblyEdit_Click()
Case #btn_Close
Break
EndSelect
EndSelect
Until Event = #PB_Event_CloseWindow
Bis DomEnumObject scheint alles zu funktionieren. Zumindest bekomme ich je mehr Fehler, je mehr Sessions ich öffne
Danke, Joe