Solidworks API

[Sturmann 34]

Здравствуйте коллеги. 

Возникла потребность повернуть деталь перпендикулярно выделенной грани (ctrl +8). 

Есть такая возможность сделать этот программно? 

[jtok 855]

Конечно. Попробуйте записать макрос, нажимая CTRL+8, а потом посмотреть код.

[Sturmann 34]

1 час назад, jtok сказал:

Конечно. Попробуйте записать макрос, нажимая CTRL+8, а потом посмотреть код.

Уже. 

Не пишет. 

[nicomed 173]

6 часов назад, Sturmann сказал:

Возникла потребность повернуть деталь перпендикулярно выделенной грани (ctrl +8). 

Есть такая возможность сделать этот программно? 

Повернуть видовое окно на деталь или изменить положение детали (сменить ее координаты) ?

Если просто повернуть, то попробуйте  ModelDoc2.ShowNamedView2()

[Sturmann 34]

1 час назад, nicomed сказал:

Повернуть видовое окно на деталь или изменить положение детали (сменить ее координаты) ?

Если просто повернуть, то попробуйте  ModelDoc2.ShowNamedView2()

Ок спасибо но к сожалению этот метод показывает только заранее заданные стандартные виды - они указаны в перечислениях

[nicomed 173]

1 час назад, Sturmann сказал:

Ок спасибо но к сожалению этот метод показывает только заранее заданные стандартные виды - они указаны в перечислениях

В ремарке к описанию метода что-то написано про поворот нормально к виду. Но я что-то не сообразил пока что именно надо указывать в параметрах вызова метода.

 

Как костыльный вариант выполните команду: swApp.RunCommand(169, "");

Изменено 21 августа пользователем nicomed

[Sturmann 34]

26 минут назад, nicomed сказал:

В ремарке к описанию метода что-то написано про поворот нормально к виду. Но я что-то не сообразил пока что именно надо указывать в параметрах вызова метода.

 

Как костыльный вариант выполните команду: swApp.RunCommand(169, "");

Спасибо попробую. 

[Sturmann 34]

1 час назад, nicomed сказал:

В ремарке к описанию метода что-то написано про поворот нормально к виду. Но я что-то не сообразил пока что именно надо указывать в параметрах вызова метода.

 

Как костыльный вариант выполните команду: swApp.RunCommand(169, "");

Спасибо помогло

[Shvg 68]

4 часа назад, Sturmann сказал:

Ок спасибо но к сожалению этот метод показывает только заранее заданные стандартные виды - они указаны в перечислениях

Кусок старого кода у меня, с этой функцией:

//---------------------
          int selType = swSelMgr.GetSelectedObjectType2(1);

            if(selType != (int)swSelectType_e.swSelFACES)
            {
                string message = "Выберите одну грань!";
                MessageBox.Show(message, "Warning!", MessageBoxButtons.OK, MessageBoxIcon.Warning);
                return;
            }

            Face2 swFace = swSelMgr.GetSelectedObject5(1) as Face2;
            Surface swSurface = swFace.IGetSurface();
            if(swSurface.IsPlane())
                swModel.ShowNamedView2("*Normal To", -1);
//--------------------------

 

Изменено 21 августа пользователем Shvg

[nicomed 173]

54 минуты назад, Shvg сказал:

swModel.ShowNamedView2("*Normal To", -1);

Увы и ах, но у меня не срабатывает. Хотя именно такой код и писал, по прочтению ремарки в документации...

 

З.Ы. пишу  в версии Framework 4.7.2 

[Shvg 68]

2 минуты назад, nicomed сказал:

Увы и ах, но у меня не срабатывает. Хотя именно такой код и писал, по прочтению ремарки в документации...

 

З.Ы. пишу  в версии Framework 4.7.2 

Проверка на плоскую поверхность была?

if(swSurface.IsPlane())

 

[nicomed 173]

 

7 минут назад, Shvg сказал:

Проверка на плоскую поверхность была?

Как сам писал не делал ( да и для идеальной синтетической проверки, где разово сам выбираешь поверхности - не вижу смысла)..

Сейчас полностью скопировал код (для чистоты эксперимента) еще добавил логирование после прохождения проверки на плоскость.

Проверка на плоскость проходит, а метод не срабатывает.

[Shvg 68]

5 минут назад, nicomed сказал:

 

Проверка на плоскость проходит, а метод не срабатывает.

Странно. Этот код был написан для SW2011. Там он работает. Правда про "*Normal To" было подсмотрено в API SW2013.  Сейчас попробовал в SW2023, компилировал в VS2015. Работает.

[nicomed 173]

9 минут назад, Shvg сказал:

Странно. Этот код был написан для SW2011. Там он работает. Правда про "*Normal To" было подсмотрено в API SW2013.  Сейчас попробовал в SW2023, компилировал в VS2015. Работает.

Самому уже интересно. Сейчас вставил в ADDIN - не работает. Вставил код с RunCommand (169,"") - отработало.

SW2021 SP2

VS2022

[nicomed 173]

@Shvg А можете сделать тестовую программку, с проверкой что у Вас она работает ? А то уже какой-то спортивный интерес просыпается ...

[Snake 60 747]

21.08.2024 в 09:53, Sturmann сказал:

Возникла потребность повернуть деталь перпендикулярно выделенной грани (ctrl +8). 

Есть такая возможность сделать этот программно? 

Вот здесь можно скачать макрос и посмотреть его код )

https://boosty.to/snake.nest/posts/a7056a15-49b7-4f80-9de4-194e9dbf3404?share=post_link

[ЮрЮрыч 7]

     Здравствуйте, развернуть модель по нормали к выбранной грани:
     Set swSelData = swModel.SelectionManager.CreateSelectData
     swFace.Select4 False, swSelData
     swModel.ShowNamedView2 "", 0

 

 

 

Как получить номер строки которую выбрал?

Изменено 9 сентября пользователем ЮрЮрыч

[alek77 222]

02.05.2024 в 15:45, alek77 сказал:

Коллеги, прошу помочь. Нужно получить координаты вершины компонента в пространстве листа чертежа.

Не могу победить матрицу трансформации (преобразования). А может и вообще все делаю не правильно.

@nicomed, @Snake 60 , наконец-то разобрался сматрицами трансформации. Возможно будет полезно.

Напомню, никак не мог получить точные координаты вершины компонента в пространстве листа.

Все время что-то не работало или работало не корректно. Только настроишь, вроде работает, хлоп ошибка, и отловить не мог.

Еще было странным, что во всех примерах что видел в матрице фигурировал масштаб листа, а масштаб вида при этом не учитывался. Но понять не мог. Это и в примерах Артема, и в примерах забугорных сайтов. Не знаю откуда это пошло, что в масштабный фактор матрицы стали заносить масшаб вида, но это в корне не верно и дает ошибку координат, если изменить масштаб вида или масштаб листа. Короче, в матрице трансформации масштабный фактор всегда должен быть равен 1#. При этом код работает отлично на любых видах и при любых масштабах. Рабочий код ниже:

Скрытый текст

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim Comp As SldWorks.Component2
Dim swVertex As SldWorks.Vertex
Dim vComps As Variant
Dim vComp As Variant
Dim vVerts As Variant
Dim vVert As Variant
Dim vEdges As Variant
Dim vEdge As Variant
Dim boolstatus As Boolean
Dim swSelMgr As SldWorks.SelectionMgr
Dim selData As SldWorks.SelectData
Dim i As Long
Dim horizontStartEnt As SldWorks.Vertex
Dim horizontEndEnt As SldWorks.Vertex
Dim verticalStartEnt As SldWorks.Vertex
Dim verticalEndEnt As SldWorks.Vertex
Dim horizontStartPtCoord As Variant
Dim horizontEndPtCoord As Variant
Dim verticalStartPtCoord As Variant
Dim verticalEndPtCoord As Variant

Sub main()
   Set swApp = Application.SldWorks
   Set swModel = swApp.ActiveDoc
   Set swDraw = swModel
   Set swModelDocExt = swDraw.Extension
   Set swSelMgr = swDraw.SelectionManager

   swDraw.ClearSelection2 True

   Set swView = swDraw.GetFirstView
   Set swView = swView.GetNextView

   Set selData = swSelMgr.CreateSelectData
   selData.View = swView

   vComps = swView.GetVisibleComponents

   Set Comp = vComps(0)
   vVerts = swView.GetVisibleEntities2(Comp, swViewEntityType_e.swViewEntityType_Vertex)
   If Not IsEmpty(vVerts) Then
      Set horizontStartEnt = vVerts(LBound(vVerts))
      swDraw.ClearSelection2 True
      boolstatus = horizontStartEnt.Select4(True, selData)
      boolstatus = swDraw.GraphicsRedraw2
   End If

   horizontStartPtCoord = horizontStartEnt.GetPoint
   Debug.Print "Model space (X,Y,Z) - (" & horizontStartPtCoord(0) * 1000 & ", " & horizontStartPtCoord(1) * 1000 & ", " & horizontStartPtCoord(2) * 1000 & ")"
   Debug.Print

   Dim swModelToViewXForm As SldWorks.MathTransform
   Set swModelToViewXForm = swView.ModelToViewTransform

   Dim swViewTransform As SldWorks.MathTransform
   Set swViewTransform = drawingToViewTransform(swView).Inverse

   Dim swMathUtils As MathUtility
   Set swMathUtils = swApp.GetMathUtility

   Dim swMathPt As SldWorks.MathPoint
   Set swMathPt = swMathUtils.CreatePoint(horizontStartPtCoord)
   Set swMathPt = swMathPt.MultiplyTransform(swViewTransform)
   Set swMathPt = swMathPt.MultiplyTransform(swModelToViewXForm)

   Dim vStartPt As Variant
   vStartPt = swMathPt.ArrayData

   Debug.Print "Drawing space (X,Y,Z) - (" & vStartPt(0) * 1000 & ", " & vStartPt(1) * 1000 & ", " & vStartPt(2) * 1000 & ")"
   Debug.Print


End Sub

Function drawingToViewTransform(swView As SldWorks.View) As SldWorks.MathTransform
   Dim swMathUtil As SldWorks.MathUtility
   Dim transformData(15) As Double
   Set swMathUtil = swApp.GetMathUtility
   transformData(0) = Cos(swView.Angle)
   transformData(1) = Sin(swView.Angle)
   transformData(2) = 0#
   transformData(3) = -Sin(swView.Angle)
   transformData(4) = Cos(swView.Angle)
   transformData(5) = 0#
   transformData(6) = 0#
   transformData(7) = 0#
   transformData(8) = 1#
   transformData(9) = swView.Position(0)
   transformData(10) = swView.Position(1)
'   Debug.Print swView.Position(0)
'   Debug.Print swView.Position(1)
   transformData(11) = 0#
   transformData(12) = 1#
   transformData(13) = 0#
   transformData(14) = 0#
   transformData(15) = 0#
   Set drawingToViewTransform = swMathUtil.CreateTransform(transformData)
End Function

 

 

[alek77 222]

Коллеги, код выше работает только для чертежей деталей, однотел или многотел без разницы.

Гораздо интереснее код для сборочных чертежей , там для корректной работы необходима дополнительная трансформация относительно базовой детали в сборке. И выбор компонента для трансформации через одно место. А это добавляет танцев. Пока разобрался, код прям всю кровь высосал. Но получилось. Сделал так, чтобы один код был и для чертежа детали, и для чертежа сборки. Не забываем, что код может взять вершины и дать их координаты в листе только там, где это физически возможно. На видах с вырезами, сечениях и т.п., где вершину не видно, код упадет. Обходы и проверки я не делал. Все в черновом варианте, не подчищал. Макрос габаритных размеров, под который я все это делал, заработал на ура.

Скрытый текст

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim Comp As SldWorks.Component2
Dim swVertex As SldWorks.Vertex
Dim vComps As Variant
Dim vComp As Variant
Dim vVerts As Variant
Dim vVert As Variant
Dim vEdges As Variant
Dim vEdge As Variant
Dim boolstatus As Boolean
Dim childrenStatus As Boolean


Dim swSelMgr As SldWorks.SelectionMgr
Dim selData As SldWorks.SelectData
Dim i As Long
Dim horizontStartEnt As SldWorks.Vertex
Dim horizontEndEnt As SldWorks.Vertex
Dim verticalStartEnt As SldWorks.Vertex
Dim verticalEndEnt As SldWorks.Vertex
Dim horizontStartPtCoord As Variant
Dim horizontEndPtCoord As Variant
Dim verticalStartPtCoord As Variant
Dim verticalEndPtCoord As Variant
Dim compForTransformation As SldWorks.Component2

Sub main()
   Set swApp = Application.SldWorks
   Set swModel = swApp.ActiveDoc
   Set swDraw = swModel
   Set swModelDocExt = swDraw.Extension
   Set swSelMgr = swDraw.SelectionManager

   swDraw.ClearSelection2 True

   Set swView = swDraw.GetFirstView
   Set swView = swView.GetNextView
'   Set swView = swView.GetNextView
'   Set swView = swView.GetNextView

   Set selData = swSelMgr.CreateSelectData
   selData.View = swView

Dim swDrawComp As SldWorks.DrawingComponent
Set swDrawComp = swView.RootDrawingComponent
'Debug.Print "swDrawComp.Name"; swDrawComp.Name
Dim vDrawCompChildArr As Variant
'Debug.Print "swDrawComp.GetChildrenCount() - "; swDrawComp.GetChildrenCount()

If swDrawComp.GetChildrenCount() > 0 Then
    vDrawCompChildArr = swDrawComp.GetChildren
    'Debug.Print "Количество детей - "; (UBound(vDrawCompChildArr))
    Dim vDrawCompChild As Variant
    Dim swDrawCompChild As SldWorks.DrawingComponent
    Set vDrawCompChild = vDrawCompChildArr(0)
    Set swDrawCompChild = vDrawCompChild
    'Debug.Print "Корневой компонент - "; swDrawCompChild.IsRoot()
    Set compForTransformation = swDrawCompChild.Component
    'Debug.Print "compForTransformation.Name"; compForTransformation.Name
    childrenStatus = True
Else
    Set compForTransformation = swDrawComp.Component
    'Debug.Print "swDrawComp.Name"; swDrawComp.Name
    childrenStatus = False
End If

   vVerts = swView.GetVisibleEntities2(compForTransformation, swViewEntityType_e.swViewEntityType_Vertex)
   'Debug.Print "Количество вершин компонента - "; (UBound(vVerts)) + 1

   If Not IsEmpty(vVerts) Then
      Set horizontStartEnt = vVerts(LBound(vVerts))
      swDraw.ClearSelection2 True
      boolstatus = horizontStartEnt.Select4(True, selData)
      boolstatus = swDraw.GraphicsRedraw2
   End If

   horizontStartPtCoord = horizontStartEnt.GetPoint
   Debug.Print "Model space (X,Y,Z) - (" & horizontStartPtCoord(0) * 1000 & ", " & horizontStartPtCoord(1) * 1000 & ", " & horizontStartPtCoord(2) * 1000 & ")"

   Dim swModelToViewXForm As SldWorks.MathTransform
   Set swModelToViewXForm = swView.ModelToViewTransform

   Dim swViewTransform As SldWorks.MathTransform
   Set swViewTransform = drawingToViewTransform(swView).Inverse

   Dim swMathUtils As MathUtility
   Set swMathUtils = swApp.GetMathUtility

   Dim swMathPt As SldWorks.MathPoint
   Set swMathPt = swMathUtils.CreatePoint(horizontStartPtCoord)


    'Блок трансформации
    Dim vStartPt As Variant
    Dim modelPt As Variant
   Set swMathPt = swMathPt.MultiplyTransform(swViewTransform)

    If childrenStatus Then
        Dim swXform As SldWorks.MathTransform
        Set swXform = compForTransformation.Transform2()
        Set swMathPt = swMathPt.MultiplyTransform(swXform)
        modelPt = swMathPt.ArrayData
    Else
        modelPt = swMathPt.ArrayData
    End If
    Debug.Print "Comp Space (X,Y,Z) - (" & modelPt(0) * 1000 & ", " & modelPt(1) * 1000 & ", " & modelPt(2) * 1000 & ")"
   Set swMathPt = swMathPt.MultiplyTransform(swModelToViewXForm)
    '***********

   vStartPt = swMathPt.ArrayData

   Debug.Print "Drawing space (X,Y,Z) - (" & vStartPt(0) * 1000 & ", " & vStartPt(1) * 1000 & ", " & vStartPt(2) * 1000 & ")"

'    'только для справки
'    'Вставка примечания с высотой в выбранную точку чертежа:
'    Dim pointNote As SldWorks.Note
'    Set pointNote = swModel.InsertNote("(" & Format(modelPt(0) * 1000, "###0.000") & ", " & Format(modelPt(1) * 1000, "###0.000") & ", " & Format(modelPt(2) * 1000, "###0.000") & ")")


End Sub

Function drawingToViewTransform(swView As SldWorks.View) As SldWorks.MathTransform
   Dim swMathUtil As SldWorks.MathUtility
   Dim transformData(15) As Double
   Set swMathUtil = swApp.GetMathUtility
   transformData(0) = Cos(swView.Angle)
   transformData(1) = Sin(swView.Angle)
   transformData(2) = 0#
   transformData(3) = -Sin(swView.Angle)
   transformData(4) = Cos(swView.Angle)
   transformData(5) = 0#
   transformData(6) = 0#
   transformData(7) = 0#
   transformData(8) = 1#
   transformData(9) = swView.Position(0)
   transformData(10) = swView.Position(1)
   transformData(11) = 0#
   transformData(12) = 1#
   transformData(13) = 0#
   transformData(14) = 0#
   transformData(15) = 0#
   Set drawingToViewTransform = swMathUtil.CreateTransform(transformData)
End Function

 

 

[Snake 60 747]

Коллеги, нужна помощь. Собственно, вопрос на скрине: https://cloud.mail.ru/public/zyhs/XJ9zgUdXd

Прилагаю деталь для тестов (Листовая деталь с конфигурациями 1,2,3 формат файла SW 2022): https://cloud.mail.ru/public/mDbk/A9RM66BtB

и модуль с кодом: https://cloud.mail.ru/public/PKbb/pT9jYU1Rn

дублирую код текстом:

Скрытый текст

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim vConfigNameArr As Variant
Dim vConfigName As Variant
Dim vcutlistItems As Variant
Dim vcutlistItem As Variant
Dim cutlistItem As SldWorks.cutlistItem
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim config As SldWorks.Configuration
Dim lRetVal As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved() As Long
Dim linkProp() As Long
Dim i As Long
Dim j As Long
Dim propName As Variant
Dim valout As String
Dim resvalout As String
Dim n As String
Dim bret As Boolean

Sub main()

    Set swApp = Application.SldWorks
    
    Set swModel = swApp.ActiveDoc
    
    vConfigNameArr = swModel.GetConfigurationNames()
       
    bret = False
    
For Each vConfigName In vConfigNameArr
                 
     
'               swModel.ShowConfiguration2 vConfigName
'               swModel.ForceRebuild3 True
' If vConfigName = "PANEL 4" Then
'    Exit For
'   Else
'           If ((vConfigName = "PANEL 1") Or (vConfigName = "PANEL 2") Or (vConfigName = "PANEL 3")) Then
             
            
            Set config = swModel.GetConfigurationByName(vConfigName)
             Debug.Print config.Name
             
             bret = swModel.ShowConfiguration2(vConfigName)
             Set config = swModel.GetActiveConfiguration
             Debug.Print config.Name
                 
              
               
'               vcutlistItems = config.GetCutListItems()
               vcutlistItems = config.GetCutListItems()
             
             i = 1
             
             For Each vcutlistItem In vcutlistItems
                 
              Debug.Print "Cut list item #" & i & " custom properties:"
                
                
                
                Set cutlistItem = vcutlistItem
                Set cusPropMgr = cutlistItem.CustomPropertyManager
             
                          
                     If i = 1 Then
                     n = ExtractNumbers(config.Name)
                     n = "ROOF PANEL FINAL " & n
'                     Debug.Print n
                     End If
'               lRetVal = cusPropMgr.Delete2("ITEM DESCRIPTION")
'               lRetVal = cusPropMgr.Delete2("Description")
'               lRetVal = cusPropMgr.Delete2("ROOF PANEL NAME")

                lRetVal = cusPropMgr.Add3("ITEM DESCRIPTION", swCustomInfoType_e.swCustomInfoText, n, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
                lRetVal = cusPropMgr.Set2("ITEM DESCRIPTION", n)
'                Debug.Print lRetVal
                
                lRetVal = cusPropMgr.Add3("Description", swCustomInfoType_e.swCustomInfoText, n, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
                lRetVal = cusPropMgr.Set2("Description", n)
'                Debug.Print lRetVal
                
                lRetVal = cusPropMgr.Add3("ROOF PANEL NAME", swCustomInfoType_e.swCustomInfoText, n, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
                lRetVal = cusPropMgr.Set2("ROOF PANEL NAME", n)
'                Debug.Print lRetVal

                swModel.ForceRebuild3 True
                
                Dim cach As Boolean
                Dim wasresol As Boolean
                Dim link As Boolean
                      
'                     bret = cusPropMgr.IsCustomPropertyEditable("Description", config.Name)
'                        If bret = True Then
'                        lRetVal = cusPropMgr.Set2("Description", n)
'                        Else
'                        Debug.Print "   Description is not editable."
'                        End If
                    lRetVal = cusPropMgr.Get6("ITEM DESCRIPTION", True, valout, resvalout, wasresol, link)
                      
                      Debug.Print "ITEM DESCRIPTION : " & resvalout
'                      Debug.Print "wascached" & cach
'                      Debug.Print "wasresolved" & wasresol
'                      Debug.Print "waslink" & link
                    lRetVal = cusPropMgr.Get6("Description", True, valout, resvalout, wasresol, link)
                      Debug.Print "Description : " & resvalout
                    
'                      Debug.Print "wascached" & cach
'                      Debug.Print "wasresolved" & wasresol
'                      Debug.Print "waslink" & link
                      
                    lRetVal = cusPropMgr.Get6("ROOF PANEL NAME", True, valout, resvalout, wasresol, link)
                    
                       Debug.Print "ROOF PANEL NAME : " & resvalout
'                      Debug.Print "wascached" & cach
'                      Debug.Print "wasresolved" & wasresol
'                      Debug.Print "waslink" & link
                      
                           
                      i = i + 1
                 
                Next
                
                
'                Else
'                Debug.Print "not a valid configuration"
'         End If
'    End If
       Next

        
End Sub
Function ExtractNumbers(str As String) As String
    Dim i As Integer
    Dim result As String
    result = ""
    
    ' Loop through each character in the string
    For i = 1 To Len(str)
        ' Check if the character is a number
        If IsNumeric(Mid(str, i, 1)) Then
            result = result & Mid(str, i, 1)
        End If
    Next i
    
    ExtractNumbers = result
End Function

 

Что нужно добавить в код, что бы решить проблему?