Solidworks API

[Kelny 1 309]

2 часа назад, malvi.dp сказал:

будьте добры тогда и файлики ТС, чтоб воспроизвести этот диалог. Спасибо.

Цитата

1 файл вызывает системные сообщения

2 файл работает без сообщений

 

вопрос на форум по импорту STL.zip

[Snake 60 744]

@Sla_68  Вообще не возникло никаких сообщений... непонятно...

https://cloud.mail.ru/public/Z5eW/ZziJLHuTy

[malvi.dp 289]

17 часов назад, Sla_68 сказал:

прикрепил код и тестовые парочку файлов:

@Kelny, тестировал оба файла на версиях sw2016 и sw2020 - никакого диалога нет.

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

Возможно, в параметрах импорта что-то изменилось в 22 версии... (у меня галочка на "Графическое тело").

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

 

 

[Sla_68 4]

Добрый день. Перезалил ссылку на гугл диск:

https://drive.google.com/file/d/1OewR3tfclw5J_Mq2gRyH4fZ34a3_y2rI/view?usp=sharing

[Sla_68 4]

у меня импорт идет в настройках obj и stl  как твердое тело.

Как сетку я не пробовал.. возможно что и ошибок нет при такой настройке импорта. Но очень хочется портить как твердотел или поверхность

там 2 файла первый - вызывает проблему, второй - не вызывает

Изменено 30 мая пользователем Sla_68

[malvi.dp 289]

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

у меня импорт идет в настройках obj и stl  как твердое тело.

Как сетку я не пробовал.. возможно что и ошибок нет при такой настройке импорта. Но очень хочется портить как твердотел или поверхность

там 2 файла первый - вызывает проблему, второй - не вызывает

Удалось таки воспроизвести этот диалог

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

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

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

Если же галочки снять, то макрос отрабатывает без диалога, а вот если вручную открыть файл, то выскакивает такое окно:

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

В этом случае нужно просто установить отметку "Больше не отображать сообщение" и оно больше не будет донимать.

[ЮрЮрыч 7]

Здраствуйте. Подскажите как програмно меняются единицы измерения. Пробовал с помощью замены стандарта - не получилось. 

[Бестолковый 5]

5 часов назад, ЮрЮрыч сказал:

Здраствуйте. Подскажите как програмно меняются единицы измерения. Пробовал с помощью замены стандарта - не получилось. 

Нижний правый угол экрана -> ПКМ по единицам измерения -> в открывшемся окне изменить то что не надо на то что надо :)

[Shvg 68]

9 часов назад, ЮрЮрыч сказал:

Здраствуйте. Подскажите как програмно меняются единицы измерения. Пробовал с помощью замены стандарта - не получилось. 

 

IModelDocExtension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitSystem, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swUnitSystem_e.<Value>), где swUnitSystem_e.<Value> перечисление
  
swUnitSystem_CGS           1 = Centimeter, gram, second 
swUnitSystem_Custom        4 = Lets you set length units, density units, and force 
swUnitSystem_IPS           3 = Inch, pound, second 
swUnitSystem_MKS           2 = Meter, kilogram, second 
swUnitSystem_MMGS          5 = Millimeter, gram, second 

[Snake 60 744]

@Бестолковый С названием топика не ошиблись? Человек спрашивает:

9 часов назад, ЮрЮрыч сказал:

как програмно меняются единицы измерения.

' VBA
' 1. Open a document in SOLIDWORKS.
' 2. Run the macro below to set inch units with
'     a fractional base of 16 and no rounding.

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Option Explicit
Sub main()
   Set swApp = Application.SldWorks
   Set Part = swApp.ActiveDoc
   Part.SetUnits swINCHES, swFRACTION, 16, 0, False
End Sub

 

Код взят отсюда: https://help.solidworks.com/2019/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.imodeldoc2~setunits.html

Вот еще описание всех методов: https://help.solidworks.com/2021/English/api/swconst/DP_Units.htm

Ну и на вкусное, статья от Артема (см. через ВПН) https://www.google.com/url?sa=t&source=web&rct=j&opi=89978449&url=https://www.codestack.net/solidworks-api/options/document/set-units/&ved=2ahUKEwjgpL-apN6GAxU7HxAIHYO0D2IQFnoECBAQAQ&usg=AOvVaw15xq49gocoVQ5BzEA31qGf

[ЮрЮрыч 7]

Спасибо. Сегодня сделал, все работает. 

[ЮрЮрыч 7]

Здравствуйте. Как определить, какие компоненты или тела находятся ближе определенного расстояния от выбранной точки. Методы интерференции к сожалению не подходит. Правильнее спросить в какую сторону двигаться? 

[Kelny 1 309]

4 часа назад, ЮрЮрыч сказал:

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

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

 

4 часа назад, ЮрЮрыч сказал:

Методы интерференции к сожалению не подходит.

Почему нет? Вставить объект от нужной поверхности и проверять интерференцию с этим объектом, кого зацепило, значит как минимум выступает за выбранную плоскость.

[nahaus 13]

Подскажите пожалуйста как получить размеры листа с помощью метода GetProperties2?
Пытаюсь получить сообщение. Что не так в строке swApp.SendMsgToUser2 swSheet.GetProperties2, swMbWarning, swMbOk

Dim swApp               As SldWorks.SldWorks
Dim swModel             As SldWorks.ModelDoc2
Dim boolstatus          As Boolean
Dim longstatus          As Long, longwarnings As Long
Dim lErrors             As Long
Dim lWarnings           As Long
Dim swSheet             As SldWorks.Sheet
Dim swDrawing           As SldWorks.DrawingDoc
Dim sheetProperties     As Variant


Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

fullPathFile = swModel.GetPathName
' swApp.SendMsgToUser2 fullPathFile, swMbWarning, swMbOk
nameFileExtension = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
' swApp.SendMsgToUser2 nameFileExtension, swMbWarning, swMbOk
nameFileWithoutExtension = Left(nameFileExtension, InStrRev(nameFileExtension, ".") - 1)
' swApp.SendMsgToUser2 nameFileWithoutExtension, swMbWarning, swMbOk

Set swSheet = swModel.GetCurrentSheet
' swApp.SendMsgToUser2 swSheet.GetName, swMbWarning, swMbOk
swApp.SendMsgToUser2 swSheet.GetProperties2, swMbWarning, swMbOk


End Sub

 

[Chuvak 33]

@nahaus  Потому что метод GetProperties2 возвращает массив свойств листа, состоящий из 8 переменных типа double:

[ paperSize, templateIn, scale1, scale2, firstAngle, width, height, sameCustomProp ]

Вам какие именно переменные из данного массива нужны:  paperSize, width или height ? Или все сразу. Тогда переделайте строку:

 

swApp.SendMsgToUser2 swSheet.GetProperties2, swMbWarning, swMbOk 

 

на
swApp.SendMsgToUser2 swSheet.GetProperties2(0), swMbWarning, swMbOk

или

 

swApp.SendMsgToUser2 swSheet.GetProperties2(5), swMbWarning, swMbOk

дальше примеры приводить не  буду, думаю поняли логику

Изменено 8 июля пользователем Chuvak

[nahaus 13]

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

Тогда переделайте строку

Выскакивает ошибка 

Она же выскакивает и без параметра в скобках.

[Chuvak 33]

@nahaus Ок, сейчас проверю у себя

 У Вас не объявлены переменные 

fullPathFile и 

nameFileExtension

Переменная  sheetProperties вообще лишняя, не используется, а тип данных имеет самый жористый)

Извините конечно за прямоту, но ваш код - полное УГ ) Может я могу вам помочь, только Вы объясните, что Вы хотите с помощью этого кода получить в результате ?

Изменено 8 июля пользователем Chuvak

[malvi.dp 289]

57 минут назад, nahaus сказал:

Что не так в строке swApp.SendMsgToUser2 swSheet.GetProperties2, swMbWarning, swMbOk

Дело в том, что"swSheet.GetProperties2" это массив св-в и прежде чем их отобразить, нужно его записать, допустим, в текстовую переменную через цикл

как-то так 

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

Set swSheet = swModel.GetCurrentSheet
Dim propM As Variant
Dim propN As String
Dim n As Integer
propN = ""
propM = swSheet.GetProperties2
    For n = LBound(propM) To UBound(propM)
        propN = propN & propM(n) & Chr(10) 
'        Debug.Print propN
    Next n
' swApp.SendMsgToUser2 swSheet.GetName, swMbWarning, swMbOk
swApp.SendMsgToUser2 propN, swMbInformation, swMbOk

 

 

[Chuvak 33]

@malvi.dp Согласен

@nahaus Попробуйте данный код:

Option Explicit

Sub main()

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swDrawing                   As SldWorks.DrawingDoc
Dim swSheet                     As SldWorks.Sheet
Dim fullPathFile                As String
Dim nameFileExtension           As String
Dim nameFileWithoutExtension    As String
Dim propM()                     As Double
Dim propN                       As String
Dim n                           As Byte

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDrawing = swModel
    
    fullPathFile = swModel.GetPathName
    ' swApp.SendMsgToUser2 fullPathFile, swMbWarning, swMbOk
    nameFileExtension = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
    ' swApp.SendMsgToUser2 nameFileExtension, swMbWarning, swMbOk
    nameFileWithoutExtension = Left(nameFileExtension, InStrRev(nameFileExtension, ".") - 1)
    ' swApp.SendMsgToUser2 nameFileWithoutExtension, swMbWarning, swMbOk
    
    Set swSheet = swDrawing.GetCurrentSheet
    propN = ""
    propM = swSheet.GetProperties2
    For n = LBound(propM) To UBound(propM)
        propN = propN & propM(n) & Chr(10)
'        Debug.Print propN
    Next n
    ' swApp.SendMsgToUser2 swSheet.GetName, swMbWarning, swMbOk
    swApp.SendMsgToUser2 propN, swMbInformation, swMbOk
    
End Sub

[nahaus 13]

17 часов назад, Chuvak сказал:

Извините конечно за прямоту, но ваш код - полное УГ

Не без этого конечно.

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

Но побудила конкретная цель: Сохранение чертежей в формат PNG.

Макрос должен понимать формат листа, или ориентацию ( портретная или альбомная), чтобы не оставлять на изображении пустые поля.

На данный момент есть такой код. Он умеет сохранять  "многолистовой" чертеж в PNG.

 

Sub main()

Dim swApp                     As SldWorks.SldWorks
Dim swModel                   As SldWorks.ModelDoc2
Dim swSheet                   As SldWorks.Sheet
Dim vSheetNameArr, vSheetName As Variant
Dim bRet                      As Boolean
Dim lErrors                   As Long
Dim lWarnings                 As Long
Dim fileName                  As String
Dim strOriginallyActiveSheet  As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

' Is document active?

If swModel Is Nothing Then

    swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk

    Exit Sub

End If

' Is it a Drawing document?

If swModel.GetType <> swDocDRAWING Then

    swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk

    Exit Sub

End If

If swModel.GetTitle = "" Then

    swApp.SendMsgToUser2 "Save the Drawing first", swMbWarning, swMbOk

    Exit Sub

End If

fileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
' swApp.SendMsgToUser2 fileName, swMbWarning, swMbO

fileName = Left(fileName, InStrRev(fileName, ".") - 1)
' swApp.SendMsgToUser2 fileName, swMbWarning, swMbO

'Change/Set DPI Settings and Paper Size here
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swTiffImageType, swTiffImageType_e.swTiffImageBlackAndWhite
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swTiffPrintDPI, 400
swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swTiffPrintPaperSize, swDwgPaperSizes_e.swDwgPaperA4size

Set swSheet = swModel.GetCurrentSheet

strOriginallyActiveSheet = swSheet.GetName

vSheetNameArr = swModel.GetSheetNames

For Each vSheetName In vSheetNameArr

    bRet = swModel.ActivateSheet(vSheetName): Debug.Assert bRet
    swModel.ViewZoomtofit2
    swModel.Extension.SaveAs fileName & "-" & vSheetName & ".PNG", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings

Next vSheetName

swModel.ActivateSheet (strOriginallyActiveSheet)

End Sub

 

17 часов назад, Chuvak сказал:

Попробуйте данный код:

Не работает. Ошибка та же.