Jump to content

Допилить макрос Что бы выгружал по папка - толщинам металл Так как идет вся солянка в сборе


Operator 1945

Recommended Posts

Operator 1945

 

Private Sub UserForm_Activate()
    CheckBox1.Value = True
    CheckBox2.Value = False
End Sub

 

 

Private Sub CommandButton3_Click()
    Dim selectedFolder As String
    
    selectedFolder = BrowseForFolder(PathOfLocks)
    If (selectedFolder <> "") And (Left(selectedFolder, 1) <> ":") Then
        selectedFolder = Replace(selectedFolder, PathOfLocks, "")
    Else
        selectedFolder = ""
    End If
    Debug.Print Left(selectedFolder, 1)
    TextBox1.Text = selectedFolder
End Sub

 

 

Function BrowseForFolder(Optional OpenAt As Variant) As Variant             - возврощает полный путь до папки выбранный пользователем 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Выбрать папку :", 0, OpenAt)
    If (Not objFolder Is Nothing) Then
        Set objFolderItem = objFolder.Self
        BrowseForFolder = objFolderItem.path
    End If
    If PathOfDirectory = BrowseForFolder & "\" Then
        BrowseForFolder = ""
    End If
End Function

 

 

Private Sub CommandButton1_Click()
    
    Dim bRet                    As Boolean
    Dim path                    As String
    Dim filename                As String
    Dim i                       As Integer
    Dim nStart                  As Single
    Dim subdir_name             As String
    Dim vComps                  As Variant
    Dim swComp                  As SldWorks.Component2
    Dim swAssy                  As SldWorks.AssemblyDoc
    Dim swBody                  As SldWorks.Body2
    Dim Bodies                  As Variant
    
    ' Set start time
    nStart = Timer
    
    ' папка с  dxf
    subdir_name = TextBox1.Text
     If subdir_name <> "" Then
        On Error Resume Next
        MkDir PathOfDirectory & subdir_name
        On Error GoTo 0
        subdir_name = subdir_name + "\"
    End If
    
    If swModel.GetType = swDocASSEMBLY Then
        Set swAssy = swModel
        vComps = swAssy.GetComponents(False)
        For i = 0 To UBound(vComps)
            Set swComp = vComps(i)
            Set swModel = swComp.GetModelDoc2
            If swComp.GetSuppression <> 0 Then
                'Debug.Print "swModel.NameView: " & swModel.GetPathName & ", CheckBox1.Value:" & CheckBox1.Value & ", swComp.IsHidden: " & swComp.IsHidden(True)
                If swModel.GetType = swDocPART And Not (swComp.IsHidden(True) And CheckBox1.Value) Then
                    Bodies = swModel.GetBodies2(swBodyType_e.swAllBodies, True)
                    Set swBody = Bodies(0)
                    If Not (swBody.IsSheetMetal = 0 And CheckBox2.Value = 0) Then
                        path = swModel.GetPathName
                        filename = Right(path, Len(path) - InStrRev(path, "\"))      ' With extension
                        filename = Left$(filename, InStrRev(filename, ".") - 1)         ' Remove extension
                        bRet = swModel.ExportFlatPatternView(PathOfDirectory & subdir_name & filename & ".DXF", 1)
                        If bRet Then
                            Debug.Print "Successful export " & filename & " to DXF extensioin."
                        Else
                            Debug.Print "UnSuccessful export " & filename & " to DXF extensioin."
                            MsgBox "UnSuccessful export " & filename & " to DXF extensioin."
                        End If
                    Else
                        path = swModel.GetPathName
                        filename = Right(path, Len(path) - InStrRev(path, "\"))      ' With extension
                        filename = Left$(filename, InStrRev(filename, ".") - 1)         ' Remove extension
                        Debug.Print filename & " is not sheet metal."
                    End If
                End If
            End If
        Next i
    ElseIf swModel.GetType = swDocPART Then
        ' geting part name
        path = swModel.GetPathName                                  ' полный_путь+имя_файла+расширение
        filename = Right(path, Len(path) - InStrRev(path, "\"))     ' With extension
        filename = Left$(filename, InStrRev(filename, ".") - 1)     ' Remove extension
        ' ïóòü áåç èìåíè ôàéëà è ðàñøèðåíèÿ
        PathOfDirectory = Strings.Left(path, Strings.Len(path) - Strings.Len(filename) - 7)
        ' Export Flat Pattern without bend (1)
        bRet = swModel.ExportFlatPatternView(PathOfDirectory & subdir_name & filename & ".DXF", 1)
        If bRet Then
            Debug.Print "Successful export " & filename & " to DXF extensioin."
        Else
            Debug.Print "UnSuccessful export " & filename & " to DXF extensioin."
            MsgBox "UnSuccessful export " & filename & " to DXF extensioin."
        End If
    ElseIf swModel.GetType = swDocDRAWING Then
        ' geting part name
        path = swModel.GetPathName                                  ' полный_путь+имя_файла+расширение
        filename = Right(path, Len(path) - InStrRev(path, "\"))     ' With extension
        filename = Left$(filename, InStrRev(filename, ".") - 1)     ' Remove extension
        ' ïóòü áåç èìåíè ôàéëà è ðàñøèðåíèÿ
        PathOfDirectory = Strings.Left(path, Strings.Len(path) - Strings.Len(filename) - 7)
        ' Export dxf
        swModel.SaveAs2 PathOfDirectory & subdir_name & filename & ".DXF", 0, True, False     ' Сохранить файл перезаписав если существует 
    Else
        MsgBox "Not assemble or part or draw."
        End
    End If
    
    ' Calculate total time
    Beep
    MsgBox "Successful export assemble/part/draw to DXF for " & Timer - nStart & " sec"
    'Dim oShell As Object
    'Set oShell = CreateObject("Shell.Application")
    'oShell.Explore (PathOfDirectory)
    
    Debug.Print vbNewLine
    UserForm1.Hide
    
End Sub

Private Sub CommandButton2_Click()
    Unload UserForm1
End Sub

 

Link to post
Share on other sites


UnPinned posts
Kelny

Так вроде уже задавали вопрос:

https://cccp3d.ru/topic/134959-помогите-пожалуйста-в-дороботки-solidworks-макроса-по-выгрузке-dxf-формата/?tab=comments#comment-1306092

 

Там же было сказано, что нужно выковырять толщину из файла, например, из глобальной переменной, если это листовой металл (или из другого места) и в зависимости от результата выбирать подпапку для сохранения, например, в путь папки добавить значение толщины (нужно найти подходящии функции в API, ниже показан принцип, а не готовое решение):

...

ЗНАЧЕНИЕ_ТОЛЩИНЫ = ФУНКЦИЯ.ВЗЯТЬ_ТОЛЩИНУ_ИЗ_МОДЕЛИ

 ' Export dxf

swModel.SaveAs2 PathOfDirectory & subdir_name & ЗНАЧЕНИЕ_ТОЛЩИНЫ & "\" & filename & ".DXF", 0, True, False     ' Сохранить файл перезаписав если существует 

...

Edited by Kelny
Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Recently Browsing   0 members

    No registered users viewing this page.



  • Сообщения

    • BSV1
      Посмотреть в микроскоп.
    • cepr
      Подскажите, как в NC210 реализовать сверлильный цикл   G81Z...R...R...F... Первая  - R плоскость безопасности при подходе Вторая - R отвод на безопасную высоту С налета Постбилдер не дает вставить еще одну R.
    • Plumber
      И еще, если не разрывать связи, то диагностика и редактирование не работает. У меня по умолчанию 3D Interconnect выключен.
    • Slavdos
      спасибо интересная идея
    • piden
      Да. Не помню, есть ли такое условие в CFX для внешних стенок. Возможно, придется создать дополнительный источник энергии на этих стенках, где тепловые потери будут привязаны через уравнение к температуре стенки. Типа Q = -1 * ε σ (Tw4 - Tv4)   -1 - потому что стенка wall с температурой Tw отдает тепло в пространство с Tv (vacuum), т.е. энергия утекает из домена. В CFX приходящие в домен величины имеют положительное значение, истекающие - отрицательное.
    • AndreyET
      Прошу прощения за долгое отсутствие, решал другие проблемы, вроде разгеб, теперь вернулся к этой. Проверил физически 24 вольта есть, на всякий случай вручную за вал прокрутил все моторы отодвинув стол от концевиков.   При отключении китайского встал сам, пока не нашел где отключить.   Ну 100 меня совсем не беспокоит   Как это сделать при EMG?
    • BSV1
      ГЧ передается заказчику, т.к. в этом документе дана информация для установки изделия на объект. Более того, зачастую ГЧ согласуется с заказчиком.
    • Moutra
      Для этого надо задать условие излучения стенок металлов, которые граничат с вакуумом?
    • Богоманшин Игорь
      Если без химии и разрушения, можно тестером попробовать. У железа и цинка разное удельное сопротивление. Один провод тестера прикрутить с хорошим контактом к детали, на другом проводе наконечник заточить без фанатизма и проверить сопротивления рядом с царапиной и внутри нее (сильно не прижимая, конечно, чтобы не проткнуть слой цинка. И в контрольном месте померить - там, где слой цинка точно отсутствует.
    • Anat2015
      Гуглить не пробовали? Судя по мануалу, у вас проблемы с кабелем, или: Ваще, как эта китайская хрень относится к ветке "Fanuc"? Кроме того, что он (Фанук) подает дискретные сигналы для управления.   BKSC-4011GS1 manual.pdf
×
×
  • Create New...