Mein COMatePlus Problem - komme einfach nicht weiter ...

Anfängerfragen zum Programmieren mit PureBasic.
Joe
Beiträge: 3
Registriert: 24.01.2014 09:46

Mein COMatePlus Problem - komme einfach nicht weiter ...

Beitrag von Joe »

Moin Jungs,
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

Hier nun mein Versuch das mit PB zu lösen:

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
Eigentlich sollte SessionType eine 2 liefern. COMate liefert aber immer nur Fehler. :roll:

Bis DomEnumObject scheint alles zu funktionieren. Zumindest bekomme ich je mehr Fehler, je mehr Sessions ich öffne :mrgreen:

Danke, Joe