Перейти к публикации
Размещайте вопросы по расчетам в соответствующем разделе

Спецификация для SW по ГОСТ

Leon

Автор: Leon,
в SolidWorks

 Рассказать Подписчики 33

Ваш опыт использования пакета макросов SWPlus  

630 пользователей проголосовало

  1. 1. Вы используете макросы из пакета SWPlus?

    • Да, постоянно на основной работе.
      460
    • Да, но не на основной работе.
      91
    • Нет
      81

  2. 2. Каие макросы из пакета Вы используете?

    • SpecEditor - для создания спецификаций и ВП
      519
    • MProp - для заполнения свойств моделей
      498
    • DProp - для управления листами чертежа
      346
    • SProp - для заполнения свойств моделей из разделов Стандартные изделия, Прочие изделия и Материалы
      328
    • SaveDRW - для "правильного" сохранения чертежа
      144
    • SaveAsPDF - для сохранения чертежа в формате PDF
      220
    • Master - для создания шаблонов основных надписей
      301

  3. 3. Были ли у Вас проблемы с освоением (изучением) макросов?

    • Нет, мне все интуитивно понятно
      164
    • Да, но я разобрался с помощью форума и описания
      313
    • Да, я до сих пор не могу разобраться как с этим работать
      100
    • Я не стал разбираться, глянул и стер все нафиг
      7
    • Я не пользовался этими макросами
      48

  4. 4. Были ли у Вас проблемы (глюки) с установкой и настройкой макросов?

    • Нет, все установилось нормально
      143
    • Да, но они решились
      282
    • Да, и я до сих пор не могу заставить макросы работать, но хочу это сделать
      154
    • Да, поэтому я и не стал с ними связываться
      7
    • Я не пользовался этими макросами
      46

  5. 5. Устраивает ли Вас подход к автоматизации оформления КД, заложенный в данных макросах?

    • Да
      284
    • Да, хотя кое-что я бы изменил
      261
    • Нет
      23
    • Не знаю
      64

Рекомендованные сообщения

  • Популярное сообщение
Leon

Leon 444

Опубликовано:
  • Популярное сообщение
Опубликовано:

Пакет макросов SWPlus

 

Здесь представлены VBA версии пакета макросов SWPlus. Также существует .Net ветка пакета, отпочковавшаяся от данной ветки в 2014 г. и поддерживаемая уважаемым @fox1001.

Одной из особенностью данных макросов является то, что все изменения, вносимые ими в документы SW, осуществляются только штатными средствами самого SW. Т.е. чертеж или спецификация, оформленные с помощью данного пакета макросов, могут быть открыты и даже отредактированы на компьютере без установленных макросов.

На данный момент разработка пакета макросов ПРЕКРАЩЕНА. По жалобам пользователей будут устранятся только критические ошибки и проблемы совместимости с новыми версиями SW. 

 

Состав и назначение пакета макросов:
SpecEditor - создание спецификаций (обычной и групповой по варианту Б) и ведомости покупных;
MProp - заполнение свойств моделей;
DProp - управление листами чертежа;
SProp - заполнение свойств моделей из разделов Стандартные изделия, Прочие изделия и Материалы;
SaveDRW - сохранение чертежа;
SaveAsPDF - сохранение чертежа в формате PDF и TIFF;
Master - создание шаблонов основных надписей;
TT - заполнение технических требований;
Roughness - простановка знака неуказанной шероховатости в углу чертежа;
RecordDimM - редактирование текста размеров;
CoolOut - преобразование размеров, проставленных с помощью инструмента "Условное обозначение отверстия", к виду по ЕСКД.

Важные советы:

Совет 1. Прочтите описание.
Совет 2. При возникновении ошибки при первом запуске макросов необходимо нажать кнопку Debug, далее зайти в меню Tools-References, убедиться в отсутствии потерянных библиотек (если таковые есть - подключить их), нажать ОК, закрыть окно с кодом макроса и снова запустить его.

Совет 3. Содержимое архива можно положить в любое место на диске, но нельзя переименовывать и удалять содержащиеся в нем файлы и папки. Макросы связаны между собой и используют общие файлы.

Совет 4. Убедитесь, что папка с макросами доступна SW для записи.

Совет 5. Для работы макроса SaveAsPDF в режиме печати на виртуальный принтер необходимо установить программу PDFCreator версии 1.2.1.

 

Описание архивов:

SWPlus 2014 SP0.0 - версия пакета SWPLus, адаптированная для SW2014 SP5.0.

SWPlus 2017 SP0.0 - версия пакета SWPLus, адаптированная для SW2017 SP4.1.

RecordDimM 2017 SP0.1 - исправленный макрос из пакета SWPlus 2017 SP0.0.

PDFCreator-1_2_1_setup - дистрибутив PDFCreator версии 1.2.1.

 

Внимание! Скачивая данный пакет макросов вы соглашаетесь с тем, что я не несу ответственность за возможные негативные последствия, связанные с использованием данных макросов. Данный пакет макросов, как и любая программа, может содержать ошибки.

 

 
GriSt прав, пускай будет отдельная тема.
Начало смотри http://fsapr2000.ru/index.php?showtopic=6071&st=40
Итак, кратко:
1. Есть неудовлетворенность существующими на сегоднящний день программами для создания спецификаций под SW.
2. Есть желание взяться за самостоятельную разработку такого продукта.
3. Есть понимание, что дело это долгое и не простое, но интересное и в случае успешного завершения ИМХО устранит последний серьезный пробел в соответствии солида ЕСКД.
4. Если даже все и заглохнет, как неоднократно бывало, то останется информация для более удачливых разработчиков.

Вот некоторые топики этого форума где ранее обсуждались вопросы, связанные со спецификацией:
http://fsapr2000.ru/index.php?showtopic=3525&st=0
http://fsapr2000.ru/index.php?showtopic=2943&st=0
http://fsapr2000.ru/index.php?show...hl=спецификация
http://fsapr2000.ru/index.php?show...hl=спецификация
http://fsapr2000.ru/index.php?show...hl=спецификация

OldCAM
Родная солидовская спецификация не устраивает как минимум по 2 причинам:
1. Нет деления на разделы.
2. Нет разбивки на страницы.
Но воспользоваться ее функциями, которые наверняка представлены в API думаю можно

 

 

SWPlus_v_2014_SP0.0.zip

SWPlus_v_2017_SP0.0.zip

 

RecordDimM_v_2017_SP0.1.zip

PDFCreator-1_2_1_setup.zip

  • Нравится 82
Ссылка на сообщение
Поделиться на других сайтах
  • 8 лет спустя...


UnPinned posts
SERoz

SERoz 201

Опубликовано:
Опубликовано:

Шипко извиняюсь, наверняка это уже обсуждалось - не нашёл...

 

При запусках макросов (DProp, MProp и т.п.), получаю энто сообщение

post-9582-0-43864500-1397578268.jpg

 

Ставил разные версии (SWPlus_v_2013_SP0 и SP1), обновлял все пути, проверял библиотеки, начинал новые проекты - всё без толку...

У меня СВ 2013 СП4 х64...

 

Пните в нужную сторону :worthy:

 

 

Ссылка на сообщение
Поделиться на других сайтах
SERoz

SERoz 201

Опубликовано:
Опубликовано:
Поделитесь идеями, пожалуйста.
При правильном заполнении свойств деталей (входящих в сборку) с помощью MProp (SProp) - формирование СП проходит автоматом...

Так же можно, формировать СП в самом солиде, использовать подготовленные шаблоны таблиц СП или создавать СП в Экселе\Ворде (и если надо - вставлять в чертёж)...

Вообще, сама СП (как документ), может формироваться в любой удобной проге (хоть в блокноте :biggrin: )...

Ссылка на сообщение
Поделиться на других сайтах
Alex8007

Alex8007 27

Опубликовано:
Опубликовано:

Выкладываю свою библиотеку. Можно брать за основу при создании более расширенной базы.

Небольшая библиотека стандартных для SWPlus.rar

  • Нравится 7
Ссылка на сообщение
Поделиться на других сайтах
Leon

Leon 444

Опубликовано:
  • Автор
Опубликовано:

Boria777

Я попробовал сделать так, чтобы MProp мог определять Обозначения и Наименования, измененные из таблицы. Попробуйте заменить кусок кода между строками

' Чтение файла и заполнение списка с профилями

и

' Заполнение списков Раздел и проверка свойства Раздел

Код:

' Чтение файла и заполнение списка с профилями
Open Source2 For Input As #1
i = 0
CboProfile.Clear
CboProfile.AddItem "Нет"
ReDim Preserve ProfDataCaption(i)
Do While Not EOF(1)
Line Input #1, strTemp
If Left$(strTemp, 3) = "$$$" Then ' Проверка, является ли строка заголовком раздела
i = i + 1
j1 = 1
k = Len(strTemp)
ReDim Preserve ProfDataCaption(i)
ProfDataCaption(i) = Right$(strTemp, k - 3)
CboProfile.AddItem ProfDataCaption(i)
Else
ProfData(i, j1) = strTemp
j1 = j1 + 1
End If
Loop
Close #1
CboProfile.ListIndex = 0

' Проверка свойства Исполнение
If swModel.CustomInfo2(sConfigName, "Исполнение") = "1" Or swModel.CustomInfo2(sConfigName, "Исполнение") = "-1" Or swModel.CustomInfo2(sConfigName, "Исполнение") = "True" Then
Исполнение.Value = True
ChkConf.Value = True
ElseIf swModel.CustomInfo2(sConfigName, "Исполнение") = "2" Then
Исполнение.Value = True
ChkConf.Value = False
strTemp = swModel.CustomInfo2(sConfigName, prpNumber)
varTemp = InStrRev(strTemp, "-")
If varTemp > 0 Then
strTemp = Right$(strTemp, Len(strTemp) - varTemp)
Else
strTemp = ""
End If
TxtConf.Value = strTemp
Else
Исполнение.Value = False
TxtConf.Value = ""
End If
ChkConf_Click
Исполнение_Click

' Фирмы и Обозначение
' Чтение файла с фирмами и заполнение списков фирм и буквенных кодов
Open Source3 For Input As #1
i = 0
CboFirm.Clear
CboClass.Clear
Do While Not EOF(1)
Line Input #1, strTemp
If i = 0 Then
CboFirm.AddItem strTemp
i = 1
Else
LTrim (strTemp)
If strTemp <> "" Then
CboClass.AddItem strTemp
End If
i = 0
End If
Loop
Close #1
' Проверка свойства Контора
CboFirm.Value = swModel.CustomInfo2(sConfigName, prpFirm)
If CboFirm.Value = "" Then
CboFirm.ListIndex = 0
End If
' Обозначение
' Получение имени модели для Обозначения
sNumberTitle = swModel.GetTitle
' Проверка на наличие расширения в имени файла
If Len(sNumberTitle) > 7 Then
strTemp = Mid$(sNumberTitle, Len(sNumberTitle) - 6, 4)
If strTemp = ".SLD" Or strTemp = ".sld" Then
sNumberTitle = Left$(sNumberTitle, Len(sNumberTitle) - 7)
End If
End If

' Проверяем наличие изменения Обозначения НЕ через MProp
If Исполнение.Value = False And swModel.CustomInfo(prpNumber) <> swModel.CustomInfo2(sConfigName, prpNumber) Then
strMsg = "Обозначение было изменено не через макрос? Обновляем Обозначение?"
lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)
If lRetval = swMbHitYes Then
ok = swModel.AddCustomInfo3("", prpNumber, 30, "")
swModel.CustomInfo2("", prpNumber) = swModel.CustomInfo2(sConfigName, prpNumber)
End If
ElseIf Исполнение.Value = True And swModel.CustomInfo(prpNumber) <> swModel.CustomInfo2(sConfigName, prpNumber) Then
strTemp = swModel.CustomInfo2(sConfigName, prpNumber)
varTemp = InStrRev(strTemp, "-")
If varTemp > 0 Then
strTemp = Left$(strTemp, varTemp - 1)
If swModel.CustomInfo(prpNumber) <> strTemp Then
strMsg = "Обозначение было изменено не через макрос? Обновляем Обозначение?"
lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)
If lRetval = swMbHitYes Then
ok = swModel.AddCustomInfo3("", prpNumber, 30, "")
swModel.CustomInfo2("", prpNumber) = strTemp
End If
End If
End If
Else
End If

' Проверяем наличие ручного ввода Обозначения
m = 0 ' Метка заданного Наименования (=1)
strTemp = "$PRP:" & Chr$(34) & "SW-File Name" & Chr$(34)
If prpFileName = 0 Then ' Разделитель не используем
If swModel.CustomInfo(prpNumber) = strTemp Or swModel.CustomInfo(prpNumber) = "" Then
ChkManual.Value = False
TxtNumber.Value = sNumberTitle
Else
If swModel.CustomInfo2("", "RenameSWP") = "0" Then ' Файл был переименован
strMsg = "Файл был переименован? Обновляем Обозначение?"
lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)
If lRetval = swMbHitYes Then
ChkManual.Value = False
TxtNumber.Value = sNumberTitle
Else
ChkManual.Value = True
TxtNumber.Value = swModel.CustomInfo(prpNumber)
End If
Else
ChkManual.Value = True
If swModel.CustomInfo2("", prpNumber) = "" Then
TxtNumber.Value = swModel.CustomInfo2(sConfigName, prpNumber)
Else
TxtNumber.Value = swModel.CustomInfo(prpNumber)
End If
End If
End If
Else ' Разделитель используем
varTemp = InStr(sNumberTitle, prpNameSep)
If varTemp > 0 Then ' Разделитель найден
strTemp1 = swModel.CustomInfo(prpNumber) & prpNameSep & swModel.CustomInfo(prpDescription)
If sNumberTitle = strTemp1 Or swModel.CustomInfo(prpNumber) = "" Or swModel.CustomInfo(prpNumber) = strTemp Then
ChkManual.Value = False
TxtNumber.Value = Left$(sNumberTitle, varTemp - 1)
Наименование.Value = Right$(sNumberTitle, Len(sNumberTitle) - varTemp - Len(prpNameSep) + 1)
m = 1
Else
If swModel.CustomInfo2("", "RenameSWP") = "0" Then ' Файл был переименован
strMsg = "Файл был переименован? Обновляем Обозначение и Наименование?"
lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)
If lRetval = swMbHitYes Then
ChkManual.Value = False
TxtNumber.Value = Left$(sNumberTitle, varTemp - 1)
Наименование.Value = Right$(sNumberTitle, Len(sNumberTitle) - varTemp - Len(prpNameSep) + 1)
m = 1
Else
ChkManual.Value = True
TxtNumber.Value = swModel.CustomInfo(prpNumber)
End If
Else
ChkManual.Value = True
TxtNumber.Value = swModel.CustomInfo(prpNumber)
End If
End If
Else ' Нет разделителя
If swModel.CustomInfo(prpNumber) = strTemp Or swModel.CustomInfo(prpNumber) = "" Then
ChkManual.Value = False
TxtNumber.Value = sNumberTitle
Else
If swModel.CustomInfo2("", "RenameSWP") = "0" Then ' Файл был переименован
strMsg = "Файл был переименован? Обновляем Обозначение?"
lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)
If lRetval = swMbHitYes Then
ChkManual.Value = False
TxtNumber.Value = sNumberTitle
Else
ChkManual.Value = True
TxtNumber.Value = swModel.CustomInfo(prpNumber)
End If
Else
ChkManual.Value = True
TxtNumber.Value = swModel.CustomInfo(prpNumber)
End If
End If
End If
End If
ChkManual_Click
' Проверка свойства Классификатор и заполнение полей для Обозначения из классификатора
If swModel.CustomInfo2("", "Классификатор") = "-1" Or swModel.CustomInfo2("", "Классификатор") = "True" Then
ChkClass.Value = True
strTemp = swModel.CustomInfo(prpNumber)
If strTemp <> "" Then
CboClass.Value = Left$(strTemp, 4)
TxtClass.Value = Mid$(strTemp, 6, 6)
TxtCounter.Value = Mid$(strTemp, 13, 3)
End If
Else
ChkClass.Value = False
CboClass.Value = ""
TxtClass.Value = ""
TxtCounter.Value = ""
End If
ChkClass_Click

' Проверка свойств Заголовок и Наименование_ФБ
If m = 0 Then
ChkEnter.Enabled = True
varTemp = InStr(swModel.CustomInfo2("", prpDescription), Chr$(10))
If varTemp > 0 Then
ChkEnter.Value = True
Else
ChkEnter.Value = False
End If
strTemp = swModel.CustomInfo2("", prpDescriptionMulti)

' Проверяем наличие изменения Наименования НЕ через MProp
If swModel.CustomInfo2(sConfigName, prpCode) = "" And swModel.CustomInfo(prpDescription) <> swModel.CustomInfo2(sConfigName, prpDescription) And swModel.CustomInfo2(sConfigName, prpDescription) <> "" Then
strMsg = "Наименование было изменено не через макрос? Обновляем Наименование?"
lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)
If lRetval = swMbHitYes Then
ok = swModel.AddCustomInfo3("", prpDescription, 30, "")
swModel.CustomInfo2("", prpDescription) = swModel.CustomInfo2(sConfigName, prpDescription)
strTemp = swModel.CustomInfo2("", prpDescription)
End If
ElseIf swModel.CustomInfo2(sConfigName, prpCode) <> "" And swModel.CustomInfo(prpDescription) <> swModel.CustomInfo2(sConfigName, prpDescription) Then
If Len(swModel.CustomInfo2(sConfigName, prpDescription)) > Len(swModel.CustomInfo2(sConfigName, prpCode)) Then
strTemp1 = Left$(swModel.CustomInfo2(sConfigName, prpDescription), Len(swModel.CustomInfo2(sConfigName, prpDescription)) - Len(swModel.CustomInfo2(sConfigName, prpCode)) - 1)
If swModel.CustomInfo(prpDescription) <> strTemp1 Then
strMsg = "Наименование было изменено не через макрос? Обновляем Наименование?"
lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)
If lRetval = swMbHitYes Then
ok = swModel.AddCustomInfo3("", prpDescription, 30, "")
swModel.CustomInfo2("", prpDescription) = strTemp1
strTemp = swModel.CustomInfo2("", prpDescription)
End If
End If
End If
Else
End If

If InStrRev(strTemp, "") > 0 Then
ChkFont.Value = True
Else
ChkFont.Value = False
End If
ChkFont_Click
If Left$(strTemp, 5) = " If InStr(strTemp, "PTS") > 0 Then
varTemp = InStrRev(strTemp, "S>") '
If Len(strTemp) > varTemp + 1 Then
strTemp = Right$(strTemp, Len(strTemp) - varTemp - 1) ' Удаляем пустую строку
Else
strTemp = ""
End If
Else
varTemp = InStrRev(strTemp, "5>")
If Len(strTemp) > varTemp + 1 Then
strTemp = Right$(strTemp, Len(strTemp) - varTemp - 1) ' Удаляем пустую строку
Else
strTemp = ""
End If
End If
End If
If strTemp = "" Then ' Если строчка пустая
strTemp = swModel.CustomInfo2("", prpDescription)
If strTemp = "" Then ' Если строчка пустая
Наименование.Value = swModel.SummaryInfo(0)
Else
Наименование.Value = strTemp
End If
Else
Наименование.Value = strTemp
End If
Else
ChkFont.Value = False
ChkFont_Click
ChkEnter.Enabled = False
ChkEnter.Value = False
End If
If prpFontSize = 0 Then ' Управление шрифтом
ChkFont.Enabled = False
Else
ChkFont.Enabled = True
End If

' Эскизные Обозначение и Наименование
TxtDraftNumber.Value = swModel.CustomInfo2("", prpDraftNumber) ' Эскизное Обозначение
TxtDraftDescription.Value = swModel.CustomInfo2("", prpDraftDescription) ' Эскизное Наименование

' Код для групповой специи
TxtCode.Text = swModel.CustomInfo2(sConfigName, prpCode)

' Список штриховок
strTemp = swApp.GetExecutablePath

strTemp = strTemp & "\lang\" & swApp.GetCurrentLanguage & "\SLDWKS.ptn"

Open strTemp For Input As #1
CboHatch.Clear
Do While Not EOF(1)
Line Input #1, strTemp
If Left$(strTemp, 1) = "*" Then
varTemp = InStr(strTemp, ",")
If varTemp > 0 Then
If Mid$(strTemp, 2, 1) = ":" Then
strTemp = Mid$(strTemp, 7, varTemp - 7)
Else
strTemp = Mid$(strTemp, 2, varTemp - 2)
End If
Else
If Mid$(strTemp, 2, 1) = ":" Then
strTemp = Mid$(strTemp, 7, Len(strTemp) - 6)
Else
strTemp = Mid$(strTemp, 2, Len(strTemp) - 1)
End If
End If
CboHatch.AddItem strTemp
End If
Loop
Close #1

' Флажок "Группировка конфигураций"
Set swConfig = swModel.GetConfigurationByName(sConfigName)
If swConfig.BOMPartNoSource = swBOMPartNumber_UserSpecified Then
strTemp = swConfig.AlternateName
If swConfig.IsDerived Then ' Производная конфигурация
While swConfig.IsDerived
Set swConfig = swConfig.GetParent
Wend
End If
If strTemp = TxtNumber.Value & "-" & swConfig.Name Then
ChkChildConfigName.Value = True
ElseIf strTemp = TxtNumber.Value Then
ChkConfigName.Value = True
End If
Else
ChkConfigName.Value = False
ChkChildConfigName.Value = False
End If

' Характер работы
' Чтение файла и заполнение списка Характер работы
CboWork.Clear
Open Source5 For Input As #1
Do While Not EOF(1)
Line Input #1, strTemp
CboWork.AddItem strTemp
Loop
Close #1
' Проверка свойства "Характер_работы"
CboWork.Value = swModel.CustomInfo2(sConfigName, prpWorkType)
' If CboWork.Value = "" Then
' CboWork.ListIndex = 0
' End If

' Чтение файла для списка Проектов и заполнение списка "Проект_ФБ"
CboProject.Clear
Open Source6 For Input As #1
i = 0
Do While Not EOF(1)
ReDim Preserve Project(i)
Line Input #1, Project(i)
CboProject.AddItem Project(i)
i = i + 1
Loop
jproject = i - 1
Close #1
CboProject.Value = swModel.CustomInfo(prpProject)
If swModel.CustomInfo(prpProject) = "" Then
CboProject.Value = swModel.CustomInfo2(sConfigName, prpProject)
End If

' Проверка свойства Заимствование
If swModel.CustomInfo2("", prpBor) <> "" Then
ChkBor.Value = True
Else
ChkBor.Value = False
End If
ChkBor_Click

 

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

Ссылка на сообщение
Поделиться на других сайтах
sasser

sasser 1

Опубликовано:
Опубликовано: (изменено)

Название макроса... Как заполняли св-ва файлов ?

Название какого макроса? Всё делается в SWPlus, свойства заполнены MProp/SProp.

 

 

Почему? Что делать?

СП солида создаётся и сортируется только по Обозначению или Наименованию (можно добавить в шаблон и другие критерии) - которые берутся из Свойств файла...

А СП макроса (Наименование и Обозначение - может браться и из имени файла), дополнительно сортируется по Деталь\Сборка\Материал и т.п., а так же и по Проект (можно добавить и другие сортировки)...

И тут всё зависит от содержимого имени файла (если конечно оно используется в формировании свойств)...

 

Дело не в сортировке или имени файла. Обе СП показаны без доработок, то есть сразу после создания.

 

Дело в том, что я не в первый раз работаю с SWPlus. Ранее такого небыло. Имею предположение что SpecEditor считает эти детали одной потому, что наименования деталей очень похожи.

Сборка одноуровневая, левая СП создана SpecEditor-ом, правая Солидом с галкой "только детали". В приложении сборка для опытов.

http://yadi.sk/d/DLYNue9CMcdKB

Изменено пользователем sasser
Ссылка на сообщение
Поделиться на других сайтах
fox1001

fox1001 789

Опубликовано:
Опубликовано:

При запусках макросов (DProp, MProp и т.п.), получаю энто сообщение

покажите скрин с библиотеками

Ссылка на сообщение
Поделиться на других сайтах
bnickl

bnickl 21

Опубликовано:
Опубликовано:

Выкладываю свою библиотеку. Можно брать за основу при создании более расширенной базы.

Жаль открыть не могу - SW11. Но, тем не менее, спасибо.

Ссылка на сообщение
Поделиться на других сайтах
fox1001

fox1001 789

Опубликовано:
Опубликовано:

Пробовал разные наборы галочек - так же...

 

а если записать эту строку вот так:

strTemp = vba.Strings.Replace(strTemp, ".", ",")
Ссылка на сообщение
Поделиться на других сайтах
SERoz

SERoz 201

Опубликовано:
Опубликовано:

а если записать эту строку вот так:

К сожалению - не помогло...

post-9582-0-73962100-1397742599.jpg

 

Причём разные макросы ругаются по-разному:

SpecEditor

post-9582-0-16203200-1397742633.jpg

 

DProp

post-9582-0-38475500-1397742685.jpg

 

Может, проблема в том, что у меня х64 версия (и оськи, и СВ) или может какой-нить VC++ или FrameWork слетел???

Впрочем, ранее проверял их - всё было нормально dntknw.gif

Ссылка на сообщение
Поделиться на других сайтах
fox1001

fox1001 789

Опубликовано:
Опубликовано:

К сожалению - не помогло...

 

я конеш не спец, но... судя по тому, что VBA не может найти собственную функцию

VBA.Strings.Replace

предполагаю проблему именно в VBA (самая верхняя библиотека на вашей картинке в посте #4490)

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

Ссылка на сообщение
Поделиться на других сайтах
SERoz

SERoz 201

Опубликовано:
Опубликовано:

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

post-9582-0-71159400-1397745223_thumb.jpg

 

:wallbash:russian_roulette.gif

 

Попробую удалить ВСЕ ВБА и переустановить из установки СВ dntknw.gif

Ссылка на сообщение
Поделиться на других сайтах
fox1001

fox1001 789

Опубликовано:
Опубликовано:

Попробую удалить ВСЕ ВБА и переустановить из установки СВ dntknw.gif

пардон  :blush:

такова се-ля-ви... как говорят у НИХ  :sad:

Ссылка на сообщение
Поделиться на других сайтах
Boria777

Boria777 0

Опубликовано:
Опубликовано:

Boria777

Я попробовал сделать так, чтобы MProp мог определять Обозначения и Наименования, измененные из таблицы. Попробуйте заменить кусок кода между строками

' Чтение файла и заполнение списка с профилями

и

' Заполнение списков Раздел и проверка свойства Раздел

Код:

' Чтение файла и заполнение списка с профилями

Open Source2 For Input As #1

i = 0

CboProfile.Clear

CboProfile.AddItem "Нет"

ReDim Preserve ProfDataCaption(i)

Do While Not EOF(1)

Line Input #1, strTemp

If Left$(strTemp, 3) = "$$$" Then ' Проверка, является ли строка заголовком раздела

i = i + 1

j1 = 1

k = Len(strTemp)

ReDim Preserve ProfDataCaption(i)

ProfDataCaption(i) = Right$(strTemp, k - 3)

CboProfile.AddItem ProfDataCaption(i)

Else

ProfData(i, j1) = strTemp

j1 = j1 + 1

End If

Loop

Close #1

CboProfile.ListIndex = 0

' Проверка свойства Исполнение

If swModel.CustomInfo2(sConfigName, "Исполнение") = "1" Or swModel.CustomInfo2(sConfigName, "Исполнение") = "-1" Or swModel.CustomInfo2(sConfigName, "Исполнение") = "True" Then

Исполнение.Value = True

ChkConf.Value = True

ElseIf swModel.CustomInfo2(sConfigName, "Исполнение") = "2" Then

Исполнение.Value = True

ChkConf.Value = False

strTemp = swModel.CustomInfo2(sConfigName, prpNumber)

varTemp = InStrRev(strTemp, "-")

If varTemp > 0 Then

strTemp = Right$(strTemp, Len(strTemp) - varTemp)

Else

strTemp = ""

End If

TxtConf.Value = strTemp

Else

Исполнение.Value = False

TxtConf.Value = ""

End If

ChkConf_Click

Исполнение_Click

' Фирмы и Обозначение

' Чтение файла с фирмами и заполнение списков фирм и буквенных кодов

Open Source3 For Input As #1

i = 0

CboFirm.Clear

CboClass.Clear

Do While Not EOF(1)

Line Input #1, strTemp

If i = 0 Then

CboFirm.AddItem strTemp

i = 1

Else

LTrim (strTemp)

If strTemp <> "" Then

CboClass.AddItem strTemp

End If

i = 0

End If

Loop

Close #1

' Проверка свойства Контора

CboFirm.Value = swModel.CustomInfo2(sConfigName, prpFirm)

If CboFirm.Value = "" Then

CboFirm.ListIndex = 0

End If

' Обозначение

' Получение имени модели для Обозначения

sNumberTitle = swModel.GetTitle

' Проверка на наличие расширения в имени файла

If Len(sNumberTitle) > 7 Then

strTemp = Mid$(sNumberTitle, Len(sNumberTitle) - 6, 4)

If strTemp = ".SLD" Or strTemp = ".sld" Then

sNumberTitle = Left$(sNumberTitle, Len(sNumberTitle) - 7)

End If

End If

' Проверяем наличие изменения Обозначения НЕ через MProp

If Исполнение.Value = False And swModel.CustomInfo(prpNumber) <> swModel.CustomInfo2(sConfigName, prpNumber) Then

strMsg = "Обозначение было изменено не через макрос? Обновляем Обозначение?"

lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)

If lRetval = swMbHitYes Then

ok = swModel.AddCustomInfo3("", prpNumber, 30, "")

swModel.CustomInfo2("", prpNumber) = swModel.CustomInfo2(sConfigName, prpNumber)

End If

ElseIf Исполнение.Value = True And swModel.CustomInfo(prpNumber) <> swModel.CustomInfo2(sConfigName, prpNumber) Then

strTemp = swModel.CustomInfo2(sConfigName, prpNumber)

varTemp = InStrRev(strTemp, "-")

If varTemp > 0 Then

strTemp = Left$(strTemp, varTemp - 1)

If swModel.CustomInfo(prpNumber) <> strTemp Then

strMsg = "Обозначение было изменено не через макрос? Обновляем Обозначение?"

lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)

If lRetval = swMbHitYes Then

ok = swModel.AddCustomInfo3("", prpNumber, 30, "")

swModel.CustomInfo2("", prpNumber) = strTemp

End If

End If

End If

Else

End If

' Проверяем наличие ручного ввода Обозначения

m = 0 ' Метка заданного Наименования (=1)

strTemp = "$PRP:" & Chr$(34) & "SW-File Name" & Chr$(34)

If prpFileName = 0 Then ' Разделитель не используем

If swModel.CustomInfo(prpNumber) = strTemp Or swModel.CustomInfo(prpNumber) = "" Then

ChkManual.Value = False

TxtNumber.Value = sNumberTitle

Else

If swModel.CustomInfo2("", "RenameSWP") = "0" Then ' Файл был переименован

strMsg = "Файл был переименован? Обновляем Обозначение?"

lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)

If lRetval = swMbHitYes Then

ChkManual.Value = False

TxtNumber.Value = sNumberTitle

Else

ChkManual.Value = True

TxtNumber.Value = swModel.CustomInfo(prpNumber)

End If

Else

ChkManual.Value = True

If swModel.CustomInfo2("", prpNumber) = "" Then

TxtNumber.Value = swModel.CustomInfo2(sConfigName, prpNumber)

Else

TxtNumber.Value = swModel.CustomInfo(prpNumber)

End If

End If

End If

Else ' Разделитель используем

varTemp = InStr(sNumberTitle, prpNameSep)

If varTemp > 0 Then ' Разделитель найден

strTemp1 = swModel.CustomInfo(prpNumber) & prpNameSep & swModel.CustomInfo(prpDescription)

If sNumberTitle = strTemp1 Or swModel.CustomInfo(prpNumber) = "" Or swModel.CustomInfo(prpNumber) = strTemp Then

ChkManual.Value = False

TxtNumber.Value = Left$(sNumberTitle, varTemp - 1)

Наименование.Value = Right$(sNumberTitle, Len(sNumberTitle) - varTemp - Len(prpNameSep) + 1)

m = 1

Else

If swModel.CustomInfo2("", "RenameSWP") = "0" Then ' Файл был переименован

strMsg = "Файл был переименован? Обновляем Обозначение и Наименование?"

lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)

If lRetval = swMbHitYes Then

ChkManual.Value = False

TxtNumber.Value = Left$(sNumberTitle, varTemp - 1)

Наименование.Value = Right$(sNumberTitle, Len(sNumberTitle) - varTemp - Len(prpNameSep) + 1)

m = 1

Else

ChkManual.Value = True

TxtNumber.Value = swModel.CustomInfo(prpNumber)

End If

Else

ChkManual.Value = True

TxtNumber.Value = swModel.CustomInfo(prpNumber)

End If

End If

Else ' Нет разделителя

If swModel.CustomInfo(prpNumber) = strTemp Or swModel.CustomInfo(prpNumber) = "" Then

ChkManual.Value = False

TxtNumber.Value = sNumberTitle

Else

If swModel.CustomInfo2("", "RenameSWP") = "0" Then ' Файл был переименован

strMsg = "Файл был переименован? Обновляем Обозначение?"

lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)

If lRetval = swMbHitYes Then

ChkManual.Value = False

TxtNumber.Value = sNumberTitle

Else

ChkManual.Value = True

TxtNumber.Value = swModel.CustomInfo(prpNumber)

End If

Else

ChkManual.Value = True

TxtNumber.Value = swModel.CustomInfo(prpNumber)

End If

End If

End If

End If

ChkManual_Click

' Проверка свойства Классификатор и заполнение полей для Обозначения из классификатора

If swModel.CustomInfo2("", "Классификатор") = "-1" Or swModel.CustomInfo2("", "Классификатор") = "True" Then

ChkClass.Value = True

strTemp = swModel.CustomInfo(prpNumber)

If strTemp <> "" Then

CboClass.Value = Left$(strTemp, 4)

TxtClass.Value = Mid$(strTemp, 6, 6)

TxtCounter.Value = Mid$(strTemp, 13, 3)

End If

Else

ChkClass.Value = False

CboClass.Value = ""

TxtClass.Value = ""

TxtCounter.Value = ""

End If

ChkClass_Click

' Проверка свойств Заголовок и Наименование_ФБ

If m = 0 Then

ChkEnter.Enabled = True

varTemp = InStr(swModel.CustomInfo2("", prpDescription), Chr$(10))

If varTemp > 0 Then

ChkEnter.Value = True

Else

ChkEnter.Value = False

End If

strTemp = swModel.CustomInfo2("", prpDescriptionMulti)

' Проверяем наличие изменения Наименования НЕ через MProp

If swModel.CustomInfo2(sConfigName, prpCode) = "" And swModel.CustomInfo(prpDescription) <> swModel.CustomInfo2(sConfigName, prpDescription) And swModel.CustomInfo2(sConfigName, prpDescription) <> "" Then

strMsg = "Наименование было изменено не через макрос? Обновляем Наименование?"

lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)

If lRetval = swMbHitYes Then

ok = swModel.AddCustomInfo3("", prpDescription, 30, "")

swModel.CustomInfo2("", prpDescription) = swModel.CustomInfo2(sConfigName, prpDescription)

strTemp = swModel.CustomInfo2("", prpDescription)

End If

ElseIf swModel.CustomInfo2(sConfigName, prpCode) <> "" And swModel.CustomInfo(prpDescription) <> swModel.CustomInfo2(sConfigName, prpDescription) Then

If Len(swModel.CustomInfo2(sConfigName, prpDescription)) > Len(swModel.CustomInfo2(sConfigName, prpCode)) Then

strTemp1 = Left$(swModel.CustomInfo2(sConfigName, prpDescription), Len(swModel.CustomInfo2(sConfigName, prpDescription)) - Len(swModel.CustomInfo2(sConfigName, prpCode)) - 1)

If swModel.CustomInfo(prpDescription) <> strTemp1 Then

strMsg = "Наименование было изменено не через макрос? Обновляем Наименование?"

lRetval = swApp.SendMsgToUser2(strMsg, swMbWarning, swMbYesNo)

If lRetval = swMbHitYes Then

ok = swModel.AddCustomInfo3("", prpDescription, 30, "")

swModel.CustomInfo2("", prpDescription) = strTemp1

strTemp = swModel.CustomInfo2("", prpDescription)

End If

End If

End If

Else

End If

If InStrRev(strTemp, "") > 0 Then

ChkFont.Value = True

Else

ChkFont.Value = False

End If

ChkFont_Click

If Left$(strTemp, 5) = " If InStr(strTemp, "PTS") > 0 Then

varTemp = InStrRev(strTemp, "S>") '

If Len(strTemp) > varTemp + 1 Then

strTemp = Right$(strTemp, Len(strTemp) - varTemp - 1) ' Удаляем пустую строку

Else

strTemp = ""

End If

Else

varTemp = InStrRev(strTemp, "5>")

If Len(strTemp) > varTemp + 1 Then

strTemp = Right$(strTemp, Len(strTemp) - varTemp - 1) ' Удаляем пустую строку

Else

strTemp = ""

End If

End If

End If

If strTemp = "" Then ' Если строчка пустая

strTemp = swModel.CustomInfo2("", prpDescription)

If strTemp = "" Then ' Если строчка пустая

Наименование.Value = swModel.SummaryInfo(0)

Else

Наименование.Value = strTemp

End If

Else

Наименование.Value = strTemp

End If

Else

ChkFont.Value = False

ChkFont_Click

ChkEnter.Enabled = False

ChkEnter.Value = False

End If

If prpFontSize = 0 Then ' Управление шрифтом

ChkFont.Enabled = False

Else

ChkFont.Enabled = True

End If

' Эскизные Обозначение и Наименование

TxtDraftNumber.Value = swModel.CustomInfo2("", prpDraftNumber) ' Эскизное Обозначение

TxtDraftDescription.Value = swModel.CustomInfo2("", prpDraftDescription) ' Эскизное Наименование

' Код для групповой специи

TxtCode.Text = swModel.CustomInfo2(sConfigName, prpCode)

' Список штриховок

strTemp = swApp.GetExecutablePath

strTemp = strTemp & "\lang\" & swApp.GetCurrentLanguage & "\SLDWKS.ptn"

Open strTemp For Input As #1

CboHatch.Clear

Do While Not EOF(1)

Line Input #1, strTemp

If Left$(strTemp, 1) = "*" Then

varTemp = InStr(strTemp, ",")

If varTemp > 0 Then

If Mid$(strTemp, 2, 1) = ":" Then

strTemp = Mid$(strTemp, 7, varTemp - 7)

Else

strTemp = Mid$(strTemp, 2, varTemp - 2)

End If

Else

If Mid$(strTemp, 2, 1) = ":" Then

strTemp = Mid$(strTemp, 7, Len(strTemp) - 6)

Else

strTemp = Mid$(strTemp, 2, Len(strTemp) - 1)

End If

End If

CboHatch.AddItem strTemp

End If

Loop

Close #1

' Флажок "Группировка конфигураций"

Set swConfig = swModel.GetConfigurationByName(sConfigName)

If swConfig.BOMPartNoSource = swBOMPartNumber_UserSpecified Then

strTemp = swConfig.AlternateName

If swConfig.IsDerived Then ' Производная конфигурация

While swConfig.IsDerived

Set swConfig = swConfig.GetParent

Wend

End If

If strTemp = TxtNumber.Value & "-" & swConfig.Name Then

ChkChildConfigName.Value = True

ElseIf strTemp = TxtNumber.Value Then

ChkConfigName.Value = True

End If

Else

ChkConfigName.Value = False

ChkChildConfigName.Value = False

End If

' Характер работы

' Чтение файла и заполнение списка Характер работы

CboWork.Clear

Open Source5 For Input As #1

Do While Not EOF(1)

Line Input #1, strTemp

CboWork.AddItem strTemp

Loop

Close #1

' Проверка свойства "Характер_работы"

CboWork.Value = swModel.CustomInfo2(sConfigName, prpWorkType)

' If CboWork.Value = "" Then

' CboWork.ListIndex = 0

' End If

' Чтение файла для списка Проектов и заполнение списка "Проект_ФБ"

CboProject.Clear

Open Source6 For Input As #1

i = 0

Do While Not EOF(1)

ReDim Preserve Project(i)

Line Input #1, Project(i)

CboProject.AddItem Project(i)

i = i + 1

Loop

jproject = i - 1

Close #1

CboProject.Value = swModel.CustomInfo(prpProject)

If swModel.CustomInfo(prpProject) = "" Then

CboProject.Value = swModel.CustomInfo2(sConfigName, prpProject)

End If

' Проверка свойства Заимствование

If swModel.CustomInfo2("", prpBor) <> "" Then

ChkBor.Value = True

Else

ChkBor.Value = False

End If

ChkBor_Click

 

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

Спасибо. Сегодня попробую и завтра отпишусь.

Ссылка на сообщение
Поделиться на других сайтах
Boria777

Boria777 0

Опубликовано:
Опубликовано:

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

If Left$(strTemp, 5) = " If InStr(strTemp, "PTS") > 0 Then

varTemp = InStrRev(strTemp, "S>") '

 

Заменил на

If Left$(strTemp, 5) = "" Then

If InStr(strTemp, "PTS") > 0 Then

varTemp = InStrRev(strTemp, "S>") '

 

Короче теперь макросы идеальные :smile: . Еще раз спасибо.

Ссылка на сообщение
Поделиться на других сайтах
Leon

Leon 444

Опубликовано:
  • Автор
Опубликовано:

@@sasser,

 

ело не в сортировке или имени файла. Обе СП показаны без доработок, то есть сразу после создания.

 

Скорее всего дело в этих настройках, именно они влияют на объединение строк. Сравните их в ваших таблицах.

post-2822-0-25285000-1398107697.jpg

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

post-2822-0-33829700-1398107706.jpg

 


@@SERoz,

Попробую удалить ВСЕ ВБА и переустановить из установки СВ

похоже действительно дело в VBA.


@@Boria777,

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

Да, что-то сползло. Хорошо, что все получилось.

  • Нравится 1
Ссылка на сообщение
Поделиться на других сайтах
  • SHARit закрыл это тему
  • SHARit разблокировал тему

Присоединяйтесь к обсуждению

Вы можете опубликовать сообщение сейчас, а зарегистрироваться позже. Если у вас есть аккаунт, войдите в него для написания от своего имени.
Примечание: вашему сообщению потребуется утверждение модератора, прежде чем оно станет доступным.

Гость
Ответить в тему...

×   Вставлено в виде отформатированного текста.   Вставить в виде обычного текста

  Разрешено не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отобразить как ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставить изображения напрямую. Загрузите или вставьте изображения по ссылке.

×
 Рассказать
Подписчики 33
Перейти к списку тем

  • Сейчас на странице   0 пользователей

    Нет пользователей, просматривающих эту страницу.



×
×
  • Создать...