Solidworks API

[Blurp 1 678]

15 минут назад, streamdown сказал:

Ниасилил смысла.

Упс, пардон! Эт я чёт не догнал сразу про Principal axes.

Тогда да, GetExtremePoint правильней. А вообще зебест - итеративный поиск для геометрии-не палки.

В качестве доказательства, что понял, о чем речь.

[Sla_68 4]

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

Sub Назначение_свойств_профиля()
'On Error GoTo ex
Dim swFace As SldWorks.face2
Dim swSurf As SldWorks.Surface
Dim swDisplayDimension As SldWorks.DisplayDimension
Dim swDim              As SldWorks.Dimension
Dim v1 As SldWorks.Vertex
Dim v2 As SldWorks.Vertex
Dim swRefAxis                   As SldWorks.RefAxis
Dim vAxisParam                  As Variant
Dim x As Double
Dim y As Double
Dim z As Double
Dim x1 As Double
Dim y1 As Double
Dim z1 As Double

Dim fx As Double
Dim fy As Double
Dim fz As Double

Dim fx1 As Double
Dim fy1 As Double
Dim fz1 As Double
Dim sm() As Double
Dim swFeatMgr As SldWorks.FeatureManager

Set swApp = Application.SldWorks

Set part = swApp.ActiveDoc
Set swFeatMgr = part.FeatureManager
Set swSelMgr = part.SelectionManager
 part.SketchManager.AddToDB = True
            swApp.SetUserPreferenceToggle swSketchAutomaticRelations, False 'автопривязки отключаем
             swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swSketchInference, False 'прилипание ..отключает все взаимосвязи
               swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False 'убивает диалог с размером false -выключает диалог

tt = part.GetTitle
   mg = Mid(tt, 10, 2)
lRetVal = part.AddCustomInfo3("", "материал", swCustomInfoText, mg)
partTitle = part.GetTitle
namedetal = partTitle & ".SLDPRT"


arrbody = part.GetBodies2(swSolidBody, False)
Set body = arrbody(0)
glavfaces = вернуть_номера_главных_плоскостей(body)
Set swFace = glavfaces(2)

Set swSurf = swFace.GetSurface
'========================================================
If swSurf.IsPlane Then
            edjearr = вернуть_2_главных_кромки(swFace1)
            Set Edge = edjearr(2)
            params = Edge.GetCurveParams2
            x1 = params(0): x2 = params(3): an1 = x1 - x2: bn1 = x2 - x1 'вектор оси
            y1 = params(1): y1 = params(4): an2 = y1 - y2: bn2 = y2 - y1
            z1 = params(2): z1 = params(5): an3 = z1 - z2: bn3 = z2 - z1
            pvec = перпендикулярный_вектор(an1, an2, an3)
            Set axeobj = Edge
            Set faceObj = swFace
            
 ElseIf swSurf.IsCylinder Then
            params = swFace.GetSurface.CylinderParams
            x1 = params(0): x2 = params(3): an1 = x1 - x2: bn1 = x2 - x1 'вектор оси
            y1 = params(1): y1 = params(4): an2 = y1 - y2: bn2 = y2 - y1
            z1 = params(2): z1 = params(5): an3 = z1 - z2: bn3 = z2 - z1
            pvec = перпендикулярный_вектор(an1, an2, an3)
            
            part.Insert3DSketch2 True 'вход строим 3 точки для плоскости
            Set swSketch = swApp.ActiveDoc.GetActiveSketch2
            swSketch.Name = "точка"
            загрузочная_точка_смещена 0.1, (x1 + x2) / 2, (y1 + y2) / 2, (z1 + z2) / 2, pvec(0), pvec(1), pvec(2), fx0, fy0, fz0
            Set swSketchPt0 = part.SketchManager.CreatePoint(fx0, fy0, fz0)
            part.Insert3DSketch2 True 'выход
            part.BlankSketch 'скрывает эскизы
            
            swSketchPt0.SelectByMark False, 2
            swFace.SelectByMark True, 2
            bret = part.InsertAxis 'вставка оси
            Set swFeatMgr = part.FeatureManager
            swFeatures = swFeatMgr.GetFeatures(True)
            Set axeobj = swFeatures(UBound(swFeatures)) 'ось
            axeobj.Name = "ось профиля"
            
            axeobj.SelectByMark False, 2
            swSketchPt0.SelectByMark True, 2
            Set faceObj = part.CreatePlaneThruLineAndPt(False) 'создает плоскость
            faceObj.Name = "плоскость распила"
            
            faceObj.SelectByMark False, 2
            axeobj.SelectByMark True, 2
            part.BlankRefGeom
            
Else
            Exit Sub
End If
'===============================================
загрузочная_точка_смещена 3, x1, y1, z1, an1, an2, an3, fx1, fy1, fz1 'точки оси
загрузочная_точка_смещена 3, x2, y2, z2, bn1, bn2, bn3, fx2, fy2, fz2 'точки оси

загрузочная_точка_смещена 0.1, fx1, fy1, fz1, pvec(0), pvec(1), pvec(2), fx11, fy11, fz11 'точки будущих линий2
загрузочная_точка_смещена 0.1, fx2, fy2, fz2, pvec(0), pvec(1), pvec(2), fx22, fy22, fz22 'точки будущих линий2
 '====================================================
faceObj.SelectByMark False, 2
part.SketchManager.InsertSketch True 'вставка 2D эскиза на рабочей плоскости
Set swSketch = swApp.ActiveDoc.GetActiveSketch2
swSketch.Name = "контур_распила"


             Dim swMathPt1      As SldWorks.MathPoint
             Dim swMathPt11     As SldWorks.MathPoint
             Dim swMathPt111    As SldWorks.MathPoint
             Dim swMathPt2      As SldWorks.MathPoint
             Dim swMathPt22     As SldWorks.MathPoint
             Dim swMathPt222    As SldWorks.MathPoint
             
               Set swMathPt1 = get2Dpoint(swSketch, fx1, fy1, fz1)
               Set swMathPt11 = get2Dpoint(swSketch, fx11, fy11, fz11)
               Set swMathPt2 = get2Dpoint(swSketch, fx2, fy2, fz2)
               Set swMathPt22 = get2Dpoint(swSketch, fx22, fy22, fz22)

Set skSegment1 = part.SketchManager.CreateCenterLine _
                (swMathPt1.ArrayData(0), swMathPt1.ArrayData(1), swMathPt1.ArrayData(2), _
                swMathPt11.ArrayData(0), swMathPt11.ArrayData(1), swMathPt11.ArrayData(2))
                
                skSegment1.SelectByMark False, 2
                axeobj.SelectByMark True, 2
                part.SketchAddConstraints "sgPERPENDICULAR"
Set skSegment2 = part.SketchManager.CreateCenterLine _
                (swMathPt2.ArrayData(0), swMathPt2.ArrayData(1), swMathPt2.ArrayData(2), _
                swMathPt22.ArrayData(0), swMathPt22.ArrayData(1), swMathPt22.ArrayData(2))
                
                skSegment2.SelectByMark False, 2
                axeobj.SelectByMark True, 2
                part.SketchAddConstraints "sgPERPENDICULAR"
'========================================================================================
Set v1 = ближайшая_вершина_к_координате(body, fx1, fy1, fz1, vdis1)
Set Edge1 = ближайшая_кромка_к_координате(body, fx1, fy1, fz1, edis1)

Set v2 = ближайшая_вершина_к_координате(body, fx2, fy2, fz2, vdis2)
Set edge2 = ближайшая_кромка_к_координате(body, fx2, fy2, fz2, edis2)
'===================================
If vdis1 <= edis1 Then
    v1.SelectByMark False, 2
    Set swStartPt1 = skSegment1.GetStartPoint2
    swStartPt1.SelectByMark True, 2
    part.SketchAddConstraints "sgCOINCIDENT"
Else
    Edge1.SelectByMark False, 2
    skSegment1.SelectByMark True, 2
    part.SketchAddConstraints "sgTANGENT"
    part.SketchAddConstraints "sgCOLINEAR"
End If
'=================
If vdis2 <= edis2 Then
v2.SelectByMark False, 2
Set swStartPt2 = skSegment2.GetStartPoint2
swStartPt2.SelectByMark True, 2
part.SketchAddConstraints "sgCOINCIDENT"
Else
edge2.SelectByMark False, 2
skSegment2.SelectByMark True, 2
part.SketchAddConstraints "sgTANGENT"
part.SketchAddConstraints "sgCOLINEAR"
End If
'=====================================
                skSegment1.SelectByMark False, 2
                skSegment2.SelectByMark True, 2
                Set swDisplayDimension = part.AddDimension2(0, 0, 0)
                Set swDim = swDisplayDimension.GetDimension
                swDim.DrivenState = 1
                swDim.Name = "длина"
                dlina = """длина@контур_распила@@default@" & namedetal & """"
                shirina = "1"
                lRetVal = part.DeleteCustomInfo2("", "длина")
                lRetVal = part.DeleteCustomInfo2("", "ширина")
                lRetVal = part.AddCustomInfo3("", "длина", swCustomInfoText, dlina)
                lRetVal = part.AddCustomInfo3("", "ширина", swCustomInfoText, shirina)
                part.SketchManager.InsertSketch True 'выход из эскиза
                part.BlankSketch ' скрыть эскиз
                
part.SketchManager.AddToDB = False
        swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swSketchInference, True 'прилипание ..отключает все взаимосвязи
        swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, True 'убивает диалог с размером true -включает диалог
        swApp.SetUserPreferenceToggle swSketchAutomaticRelations, True  'автопривязки включаем
End Sub
Function ближайшая_вершина_к_координате(body, x, y, z, dis)
           vList = body.GetVertices
           Dim arr() As Double
           Dim edjpoint As Variant
           Dim arrobj() As Object
           Dim arrobjdis() As Double
            If IsEmpty(vList) Then
            dis = 1000000
            Set ближайшая_вершина_к_координате = Nothing
            Exit Function
            End If
                        For i = 0 To UBound(vList)
                            edjpoint = vList(i).GetClosestPointOn(x, y, z) 'ближайшая точка
                            ReDim Preserve arr(i) 'массив дистанций
                            ReDim Preserve arrobj(i)
                            arr(i) = длина_линии(x, y, z, edjpoint(0), edjpoint(1), edjpoint(2))
                            Set arrobj(i) = vList(i)
                        Next i
                            max_min_indexarray arr, max1n, max2n, min1n, min2n
                            dis = arr(min1n)
                            Set ближайшая_вершина_к_координате = arrobj(min1n)
End Function
Function ближайшая_кромка_к_координате(body, x, y, z, dis)
            edgeList = body.GetEdges
           Dim arr() As Double
           Dim edjpoint As Variant
           Dim arrobj() As Object
           Dim arrobjdis() As Double
            
                        For i = 0 To UBound(edgeList)
                            edjpoint = edgeList(i).GetClosestPointOn(x, y, z) 'ближайшая точка
                            ReDim Preserve arr(i) 'массив дистанций
                            ReDim Preserve arrobj(i)
                            arr(i) = длина_линии(x, y, z, edjpoint(0), edjpoint(1), edjpoint(2))
                            Set arrobj(i) = edgeList(i)
                        Next i
                            max_min_indexarray arr, max1n, max2n, min1n, min2n
                            dis = arr(min1n)
                            Set ближайшая_кромка_к_координате = arrobj(min1n)
End Function
  Sub max_min_indexarray(mass, max1n, max2n, min1n, min2n) 'сортировка и удаление повторов в массиве
max1n = 0
max2n = 0
min1n = 0
min2n = 0
For i = LBound(mass) To UBound(mass)
    If CDbl(mass(i)) > max1 Then max1 = CDbl(mass(i))
       
Next i
max2 = 0
For i = LBound(mass) To UBound(mass)
    If CDbl(mass(i)) = max1 Then
        max1n = i
        Exit For
    End If
Next i
For i = LBound(mass) To UBound(mass)
    If CDbl(mass(i)) > max2 And i <> max1n Then
        max2n = i
        max2 = mass(i)
        
    End If
Next i


''''''''''''''''''''''''''''''''''''''''''''''''''обратная
min1 = max1
For i = LBound(mass) To UBound(mass)
    If CDbl(mass(i)) < min1 Then min1 = CDbl(mass(i))
       
Next i

min2 = max1

For i = LBound(mass) To UBound(mass)
    If CDbl(mass(i)) = min1 Then
        min1n = i
        Exit For
    End If
Next i

For i = LBound(mass) To UBound(mass)
    If CDbl(mass(i)) < CDbl(min2) And i <> min1n Then
        min2n = i
        min2 = CDbl(mass(i))
        
    End If
Next i

End Sub

 

Hide  

 

[Blurp 1 678]

@streamdown 

Скачал и поигрался с произвольно ориентированной палкой.

Правда VS у меня стоит для мебели.  

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

 

 

[Sla_68 4]

Подскажите, плиз как можно скрыть текст чтобы сообщение было не большого размера.

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

Еще вопрос, если усложнить задачу и попробовать просчитать маршрут профиля как на картинке..Реально ли? Трудности опять же в поворотах.  Пока что думаю над алгоритмом. Я канеш понимаю , есть встроенные средства. Честно говоря не пользовался таковыми.

Для расчета такой трубы не составит большого труда определить ей длину если не ставить задачу параметрических привязок. Напрмер высчитать объем тела и площадь сечения ну и поделить , получим длину. А вот как сделать это параметрически с привязками и построениями?

Изменено 17 января 2018 пользователем Sla_68

[zerganalizer 570]

Я бы делал поиском всех ребер (это будут все круглые сечения), по каждому сечению провести "спайн" (spine) (не сплайн) - к сожалению, распознает сплайн (желтым), а не полилинию со скруглениями в угле (белым), и длина не совпадет. Более сложные методы - не уверен, что хватит API и терпения.

[streamdown 1 565]

11 час назад, Sla_68 сказал:

Я канеш понимаю , есть встроенные средства.

Какие? 

11 час назад, Sla_68 сказал:

А вот как сделать это параметрически с привязками и построениями?

Какими?

 

Варианты ещё:

По первому - ищите эскиз-направление, вычисляйте суммы всех отрезков. Работает только для Swept.

По второму - телу давайте атрибут, поверхности имя. Подписывайтесь на ребилд и автоматом пересчитывайте, найдя нужные.

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

по каждому сечению провести "спайн" (spine)

Как можно быть настолько невнимательным, чтобы в теме по программированию API SW вставлять картинки геометрических построений из других CAD систем? Вы и работаете так же? ))) Наот...ись.

[zerganalizer 570]

18 минут назад, streamdown сказал:

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

по каждому сечению провести "спайн" (spine)

Как можно быть настолько невнимательным, чтобы в теме по программированию API SW вставлять картинки геометрических построений из других CAD систем? Вы и работаете так же? ))) Наот...ись.

Brep везде один, алгоритмы те же. И команды, если они есть...

 

И я не в вашу ветку писал, и не вам пытался помочь. Поэтому от...сь...

Изменено 18 января 2018 пользователем zerganalizer

[streamdown 1 565]

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

пытался помочь

Чем?)))

С радостью (серьёзно) посмотрю и послушаю совета где в API SW да и вообще в SW найти "spine". Самому пригодится.

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

И я не в вашу ветку писал

Да и форум не мой  так что вообще мимо.

[zerganalizer 570]

3 минуты назад, streamdown сказал:

С радостью (серьёзно) посмотрю и послушаю совета где в API SW да и вообще в SW найти "spine". Самому пригодится.

А какая разница - есть или нет, если даже он толком не распознает. Остальные методики гораздо сложнее...

[Sla_68 4]

30 минут назад, streamdown сказал:

Какие? 

Электричество, маршрут.

 

31 минуту назад, streamdown сказал:

По первому - ищите эскиз-направление,

Эскиза нет. Тело получено импортом

14 минуты назад, zerganalizer сказал:

Поэтому от...сь...

Не красиво.

[zerganalizer 570]

 

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

18 минут назад, zerganalizer сказал:

Поэтому от...сь...

Не красиво.

36 минут назад, streamdown сказал:

Как можно быть настолько невнимательным, чтобы в теме по программированию API SW вставлять картинки геометрических построений из других CAD систем? Вы и работаете так же? ))) Наот...ись.

Некрасиво на некрасивый пост не по теме и не в ответ мне.

[Sla_68 4]

Я пишу вам потому что и вы и он ведете себя по отношению друг к другу агрессивно. Отвечать грубостью на грубость вас не красит. Вы вполне разумно можете обосновать человеку свое видение вопроса. А такие как я поймут вас в степени своего воспитания и умственного развития. Я вчера перешел по ссылке Олега в тему про быдлокодерство. И понял что статья частично про меня и мое невежество. Каюсь, грешен . Есть куча кода который написан еретически. Да и задаю порой вопросы как "блондинко". Люди , такую подачу не любят. Но чего я не позволяю себе -так это хамить оппоненту. Считаю лучшим способом задеть человека - интеллектуальный троллинг. Это когда мы с вами не прибегаем к быдло-жаргону и без нарушения правил этики, указываем человеку на ошибку...

43 минуты назад, zerganalizer сказал:

Как можно быть настолько невнимательным, чтобы в теме по программированию API SW вставлять картинки геометрических построений из других CAD систем? Вы и работаете так же? ))) Наот...ись.

В этой фразе нет оскорбления, тут очень интересно проделан тролинг. Подача в виде вопроса и это не означает что вы работаете на отъ...сь. Те ваше сознание рисует то, чего нет. У меня например не возникло такой мысли.

 

Вот немного кода не параметрического расчета бобышек по траектории в длине...

Sub Назначение_свойств_профиля_по_траектории()
Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
 arrbody = part.GetBodies2(swSolidBody, False)
Set body = arrbody(0)
glavfaces = вернуть_номера_минимальных_плоскостей(body)'функция находит плоскость с мин площадью (ползовательская)
Set swFace = glavfaces(2)
facearea = swFace.GetArea * 1000000#
nDensity = part.GetUserPreferenceDoubleValue(swMaterialPropertyDensity)
vMassProps = body.GetMassProperties(nDensity)
vol = vMassProps(3) * 1000000000#
l = vol / facearea 'длина
End Sub

Показать содержимое  

 

Hide  

[streamdown 1 565]

12 минуты назад, Sla_68 сказал:

перешел по ссылке

Оно адресовано было не вам 

 

53 минуты назад, zerganalizer сказал:

Остальные методики гораздо сложнее

Какие вы знаете методики по данному вопросу, которые можно реализовать программированием с применением только среды Solidworks и только любого языка программирования от Microsoft?

Я даже (наверное) сподоблюсь их реализовать, ибо тема интересная.

offtop:

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

картиночники добрались и до программирования))) жуть...

12 минуты назад, Sla_68 сказал:

расчета бобышек по траектории

какая погрешность результата на 1 метр?

Изменено 18 января 2018 пользователем streamdown

[zerganalizer 570]

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

Считаю лучшим способом задеть человека - интеллектуальный троллинг.

Не интересно - не жми...  

Всяк по своему - а троллинг это еще хуже. Послал - и все, порядок, забыл.

Hide  

 

55 минут назад, streamdown сказал:

Какие вы знаете методики по данному вопросу, которые можно реализовать программированием с применением только среды Solidworks и только любого языка программирования от Microsoft?

Я даже (наверное) сподоблюсь их реализовать, ибо тема интересная.

Не советую жать  

На о...сь писать не буду, подробнее - создавайте свои темы, может, зайду, но не факт. Алгоритм распознавания у меня есть, но он сопряжен со сложными построениями с участием кода. Я даже тестил - но работает только либо для гладких путей, либо для ломаных - разные алгоритмы. И нестабильно работало на старых фичах доступа к топологии солида. Новыми - НЕ ПРОБОВАЛ... Только катия и VB(S)...

Hide  

Изменено 18 января 2018 пользователем zerganalizer

[Sla_68 4]

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

какая погрешность результата на 1 метр?

Можно смело до 5 % (а  вообще это надо для электропроводки)

[streamdown 1 565]

Что и следовало ожидать. Как ранее и писал:

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

картиночники добрались и до программирования))) жуть...

Мне абсолютно по барабану что вы там делаете и где и в чём. Так же - по барабану как  Но так как считаю себя чутка шарящим в теме API SW  и чуть поболее чем чутка в программировании, то буду всячески разубеждать общественность от необдуманных действий и последствий таких вот картиночников в данной теме. На усмотрение вопрошающих: прислушиваться к советам или их игнорировать. Но то что есть грамотные подходы к решению задач, а не через жопу и в другой CAD, представляю.

И специально для вас @zerganalizer  - я не знаю и не особо горю желанием изучать ваши возможности и способности в CATIA. Может быть (именно так) вы в той области специалист. Но если уж очень хочется что-то там посравнивать, есть специальные разделы форума, одобренные администрацией и правилами, на которые вы соглашались при регистрации на форуме. Не хотите их соблюдать - ваше право.

Так что не обессудьте, вставляя очередной скриншот вашей любимой катии 

 

Изменено 18 января 2018 пользователем streamdown

[zerganalizer 570]

16 минут назад, streamdown сказал:

картиночники добрались и до программирования))) жуть...

О ком речь-то??? Я на API не чутка программирую и давно, куча разработок из-за которых меня приглашали на COFES. Только API другого САПРа, впрочем, код практически тот-же, как я смотрю. Походу, "не делай хорошо - не обос...т"...

[streamdown 1 565]

@Sla_68 если от вас что-то зависит, то попробуйте утвердить правило, что для создания сложных профилей по сечениям использовать команду "По траектории". Или же создавать направляющие оси в модели.

Второе - это вообще отличный выход. Как было на одном предприятии, кому делал программу. Там ввели в модель специальный обязательный эскиз-точку, который транслировался в чертёж. По этой точке я определял положение, угол, грань - куда надо было вставлять примечание для гравировки на листовом. Ибо обычный эскиз-примечание в модели при развёртке "улетал" или менял грань-ориентацию, а булевской операцией этого делать было нельзя.

3 минуты назад, streamdown сказал:

Или же создавать направляющие оси в модели.

Но это уже должны делать не лично вы и кодом и хрен знает как - а конструктор, который осознаёт что он делает и как.

Изменено 18 января 2018 пользователем streamdown

[Sla_68 4]

23 минуты назад, streamdown сказал:

@Sla_68 если от вас что-то зависит

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

Поэтому правило сам придумываю и редактирую. Я уже писал выше что в дереве посторения нет фичеров и эскизов поскольку импортировал деталь.

Для решения задачи , ограничил деталь следующими условиями:

1) В основаниии сечения использую окружность.

2) Маршрут состоит из отрезков и дуг (сплайн и другие кривые не используем)

 

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

Трудности вызывает пока что мысль о построении дуг на изгибах провода.

[Blurp 1 678]

Полюбасу даун прав насчет картиночников. Ну его нафиг енто апи.

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