MACRO: Exporter chaque corps d'une pièce dans un fichier x_t

vos questions concernant les API SolidWorks

MACRO: Exporter chaque corps d'une pièce dans un fichier x_t

Messagepar olivedelaporte » Lun 25 Nov 2013, 12:33

Bonjour à tous,

Je suis un utilisateur de solidworks et j'aimerai utiliser une macro afin d'exporter chaque corps d'une pièce dans un fichier enregistré en parasolid...

Je ne m'y connais pas du tout en code... Oui je sais c'est un problème pour commencer dans les macros.

Pouvez-vous m'aider s'il vous plait :( ...

Merci d'avance.

Olive
olivedelaporte
Ewok SolidWorks
 
Messages: 1
Inscription: Lun 25 Nov 2013, 11:53

Re: MACRO: Exporter chaque corps d'une pièce dans un fichier

Messagepar Titifonky » Mer 12 Fév 2014, 9:42

Bonjour,

C'est un peu costaud pour une première macro.

Voici un debut provenant de l'aide SW.
Enregistre le corps sélectionné dans un fichier.
Il faut ensuite enregistrer le fichier en parasolid

http://help.solidworks.com/2014/English/api/sldworksapi/Save_Solid_Body_to_File_Example_VB.htm

Code: Tout sélectionner
Dim Swapp As SldWorks.SldWorks
Dim swFeat As SldWorks.Feature
Dim swBodyFolder As SldWorks.BodyFolder
Dim updateBoolstatus As Boolean
Dim boolstatus As Boolean
Dim longstatus As Long
Dim longWarnings As Long
Dim currentModel As SldWorks.ModelDoc2
Dim swModel As SldWorks.ModelDoc2
Dim modelType As Long
Dim modelTitle As String

Option Explicit
Sub main()

    Set Swapp = Application.SldWorks
    Set currentModel = Swapp.ActiveDoc
   

    modelTitle = currentModel.GetTitle
    modelType = currentModel.GetType
   

    Set swFeat = currentModel.FirstFeature
    If swFeat Is Nothing Then ErrorMsg Swapp, "Failed to get first feature"
   

    Do While Not swFeat Is Nothing
        If swFeat.GetTypeName2 = "SolidBodyFolder" Then
            Set swBodyFolder = swFeat.GetSpecificFeature2
            If swBodyFolder Is Nothing Then ErrorMsg Swapp, "Failed to get body folder"
                                   

            boolstatus = swBodyFolder.SetAutomaticCutList(True)
                   

            boolstatus = swBodyFolder.UpdateCutList()
           

            Exit Do
        End If
        Set swFeat = swFeat.GetNextFeature
    Loop
   

    updateBoolstatus = False
   

    Set swFeat = currentModel.FirstFeature
    If swFeat Is Nothing Then ErrorMsg Swapp, "Failed to get first feature"
   

    Do While Not swFeat Is Nothing
        If swFeat.GetTypeName2 = "WeldMemberFeat" Then
            boolstatus = swFeat.Select2(False, 0)
            If boolstatus = False Then ErrorMsg Swapp, "Failed to select feature"
   

            ' Save the selected solid body weldment member to another part,
            ' transferring the solid body's cut list properties to the new part's cut list;
            ' automatically creates a weldment and cut list folder
            boolstatus = currentModel.SaveToFile3(Swapp.GetCurrentMacroPathFolder + "\RefWeldment1" + ".sldprt", 1, swCutListTransferOptions_CutListProperties, False, "", longstatus, longWarnings)
            Stop
            If boolstatus = False Then ErrorMsg Swapp, "Failed to insert weldment member into new part"
   

            Set swModel = Swapp.ActiveDoc
            If swModel Is Nothing Then ErrorMsg Swapp, "Failed to set open model as active document"
           

           updateBoolstatus = True
            Exit Do
        End If
        Set swFeat = swFeat.GetNextFeature
    Loop
   

    If updateBoolstatus = True Then
        Set swFeat = currentModel.FirstFeature
        If swFeat Is Nothing Then ErrorMsg Swapp, "Failed to get first feature"
       

        Do While Not swFeat Is Nothing
            If swFeat.GetTypeName2 = "SolidBodyFolder" Then
                Set swBodyFolder = swFeat.GetSpecificFeature2
                If swBodyFolder Is Nothing Then ErrorMsg Swapp, "Failed to get body folder"
               

                boolstatus = swBodyFolder.SetAutomaticCutList(True)
                If boolstatus = False Then ErrorMsg Swapp, "Failed to set cut list to automatic"
               

                boolstatus = swBodyFolder.UpdateCutList()
                If boolstatus = False Then ErrorMsg Swapp, "Failed to update cut list"
               

             Swapp.CloseDoc swModel.GetTitle
                Exit Do
            End If
            Set swFeat = swFeat.GetNextFeature
        Loop
    End If

End Sub

Function ErrorMsg(Swapp As Object, Message As String)
    Swapp.SendMsgToUser2 Message, 0, 0
    Swapp.RecordLine "'*** WARNING - General"
    Swapp.RecordLine "'*** " & Message
    Swapp.RecordLine ""
End Function
Titifonky
Padawan SolidWorks
 
Messages: 89
Inscription: Mar 05 Avr 2011, 8:23
Localisation: Lille .............. SW Premium 2013 .......... Seven 64b


Retourner vers Questions générales sur les API

 


  • Articles en relation
    Réponses
    Vus
    Dernier message

Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 5 invités

banniere