Перейти к публикации

Программирование


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

В SW есть функция записи макроса есть ли такоеже в SE, UG, Pro/e? :wallbash:

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


В pro/e есть возможность создавать макросы.Затем можно создать кнопку и к ней привязаит макрос.

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

pro/e поддерживает запись деиствий юзера, т.е. открытие, закрытие, стирание сессии вплоть до создания эскиза, а дальше никак, спасибо, но не то :sad:

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

pro/e поддерживает запись деиствий юзера, т.е. открытие, закрытие, стирание сессии вплоть до создания эскиза, а дальше никак, спасибо, но не то

если я правильно вас понял,вы, очевидно, спутали trail-файлы с макросами. Именно,можно по запрограмированным кнопкам выполнять,в принципе,любые действия,которые есть в меню.Комманда называется Mapkey.

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

Все правильно, только trail-файл нельзя выполнить, т. е. повторить действия, вообще то стоит задача программно описать парт с возможностью последующего выполнения макроса (скрипта)

например для Catia

Language="VBSCRIPT"

Sub CATMain()

Dim partDocument1 As Document

Set partDocument1 = CATIA.ActiveDocument

Dim part1 As Part

Set part1 = partDocument1.Part

Dim bodies1 As Bodies

Set bodies1 = part1.Bodies

Dim body1 As Body

Set body1 = bodies1.Item("MechanicalTool.1")

Dim sketches1 As Sketches

Set sketches1 = body1.Sketches

Dim reference1 As Reference

Set reference1 = part1.CreateReferenceFromName("Selection_RSur:(Face:(Brp:(Pad.1;2);None:());Pad.1)")

Dim sketch1 As Sketch

Set sketch1 = sketches1.Add(reference1)

Dim arrayOfVariantOfDouble1(8)

arrayOfVariantOfDouble1(0) = 20.000000

arrayOfVariantOfDouble1(1) = 0.000000

arrayOfVariantOfDouble1(2) = 0.000000

arrayOfVariantOfDouble1(3) = 0.000000

arrayOfVariantOfDouble1(4) = 1.000000

arrayOfVariantOfDouble1(5) = 0.000000

arrayOfVariantOfDouble1(6) = 0.000000

arrayOfVariantOfDouble1(7) = 0.000000

arrayOfVariantOfDouble1(8) = 1.000000

sketch1.SetAbsoluteAxisData arrayOfVariantOfDouble1

Dim factory2D1 As Factory2D

Set factory2D1 = sketch1.OpenEdition()

Dim geometricElements1 As GeometricElements

Set geometricElements1 = sketch1.GeometricElements

Dim axis2D1 As GeometricElement

Set axis2D1 = geometricElements1.Item("AbsoluteAxis")

Dim line2D1 As AnyObject

Set line2D1 = axis2D1.GetItem("HDirection")

line2D1.ReportName = 1

Dim line2D2 As AnyObject

Set line2D2 = axis2D1.GetItem("VDirection")

line2D2.ReportName = 2

Dim circle2D1 As Circle2D

Set circle2D1 = factory2D1.CreateClosedCircle(0.000000, 0.000000, 10.000000)

Dim point2D1 As AnyObject

Set point2D1 = axis2D1.GetItem("Origin")

circle2D1.CenterPoint = point2D1

circle2D1.ReportName = 3

Dim constraints1 As Constraints

Set constraints1 = sketch1.Constraints

Dim reference2 As Reference

Set reference2 = part1.CreateReferenceFromObject(circle2D1)

Dim constraint1 As Constraint

Set constraint1 = constraints1.AddMonoEltCst(14, reference2)

constraint1.Mode = 0

Dim length1 As Dimension

Set length1 = constraint1.Dimension

length1.Value = 10.000000

sketch1.CloseEdition

part1.Update

Dim shapeFactory1 As Factory

Set shapeFactory1 = part1.ShapeFactory

Dim pad1 As Pad

Set pad1 = shapeFactory1.AddNewPad(sketch1, 20.000000)

part1.Update

End Sub

:smile:

или для SW

Dim swApp As Object

Public Part As Object

Dim Gtol As Object

Const swDisplayTemporaryAxes = 7

Const swDocPART = 1

Dim res As Boolean

Sub main()

Set swApp = CreateObject("SldWorks.Application")

swApp.Visible = True

swApp.DocumentVisible True, swDocPART

Set Part = swApp.NewPart

Let d = 22 / 2000

Let p = 1.5 / 1000

Let s = 34 / 1000

Let H = 14 / 1000

Let R = 1 / 1000

Let L = 105 / 1000

Let Lo = 50 / 1000

Part.SetAddToDB True

Part.SelectByID "Ñïåðåäè", "PLANE", 0, 0, 0

Part.InsertSketch

Part.CreateCircle 0, 0, 0, d, 0, 0

Part.ShowNamedView2 "*Isometric", 7

Part.FeatureExtrusion 1, 0, 1, 0, 0, L, 0, 0, 0, 1, 1, 0, 0, 0, 0

res = swApp.SetUserPreferenceToggle(swDisplayTemporaryAxes, True)

vRotate

Part.SelectByID "Ñïåðåäè", "PLANE", 0, 0, 0

Part.InsertSketch

Part.CreateLineVB 0, s / 1.732050808, 0, s / 2, s / (2 * 1.732050808), 0

Part.CreateLineVB s / 2, s / (2 * 1.732050808), 0, s / 2, -s / (2 * 1.732050808), 0

Part.CreateLineVB s / 2, -s / (2 * 1.732050808), 0, 0, -s / 1.732050808, 0

Part.CreateLineVB 0, -s / 1.732050808, 0, -s / 2, -s / (2 * 1.732050808), 0

Part.CreateLineVB -s / 2, -s / (2 * 1.732050808), 0, -s / 2, s / (2 * 1.732050808), 0

Part.CreateLineVB -s / 2, s / (2 * 1.732050808), 0, 0, s / 1.732050808, 0

Part.FeatureBoss 1, 0, 0, 0, 0, H, 0, 0, 0, 1, 1, 0, 0, 0, 0

Part.SelectByID "", "EDGE", d, 0, 0

Part.FeatureFillet R, 1, 0, 0, 0

Part.SelectByID "", "FACE", 0, 0, -L

Part.FeatureChamfer 7 * 1.732050808 * p / 16, 0.7853981633975, 1

Part.SelectByID "", "EDGE", d - (7 * 1.732050808 * p / 16), 0, -L

Part.InsertCosmeticThread 0, 2 * (d - 17 * 1.732050808 * p / 48), Lo, ""

Part.SelectByID "Ñïðàâà", "PLANE", 0, 0, 0

Part.InsertSketch

Part.CreateLineVB -H, -1.1 * s, 0, -H, -0.45 * s, 0

Part.CreateLineVB -H, -1.1 * s, 0, -H + 0.65 * s / 2, -1.1 * s, 0

Part.CreateLineVB -H + 0.65 * s / 2, -1.1 * s, 0, -H, -0.45 * s, 0

Part.CreateCenterLineVB 0, 0, 0, -H, 0, 0

Part.FeatureRevolveCut 6.28318530718, 0, 0.000314159265359, 0

vRotate

Part.ViewZoomtofit

Part.Clearselection

End Sub

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

Jackal2004

Ну то что я лично увидел из вашего примера так это подобие кода VB. У SE, макро - это программа написанная на VB или С++ использующая API SE.

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

Jackal2004

Многогранники

Attribute VB_Name = "frmPolygon"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Option Explicit

Private Sub chkConstrain_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.labMessage.Caption = "Select to automatically constrain the polygon profile"

End Sub

Private Sub cmdCancel_Click()

MacroDone

End Sub

Private Sub cmdCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.labMessage.Caption = "Ends the Polygon tool"

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.labMessage.Caption = ""

End Sub

'

' The primary form should not simply be unloaded. You should set the Intergraph Command

' Control.Done property to True when you want the form to be unloaded. Then unload the form in the

' Class_Terminate method.

'

Private Sub Form_QueryUnload(cancel As Integer, unloadmode As Integer)

If unloadmode = vbFormControlMenu Then

igCommand1.Done = True

End If

End Sub

'

' The Activate event is where the macro should show its form if it

' should be displayed.

'

Private Sub igCommand1_Activate()

' Center the form within the application

Call CenterForm(igCommand1.Application.hWnd, Me)

frmPolygon.Show

End Sub

'

' The Deactivate event is where the macro should hide its form if it

' was displayed. The macro should not unload the form here.

' The macro's form should be unloaded in the Class Module Terminate event.

'

Private Sub igCommand1_Deactivate()

' frmPolygon.Hide

End Sub

'

' This subroutine terminates the macro and should be called from the event

' that dismisses your form, for example an OK button.

'

Private Sub MacroDone()

frmPolygon.Hide

igCommand1.Done = True

End

End Sub

Private Sub igMouse1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Double, ByVal Y As Double, ByVal z As Double, ByVal Window As Object, ByVal KeyPointType As Long, ByVal Graphic As Object)

On Error GoTo ErrorTrap

Dim cMsg As String

Dim Profile As Object

Dim ProfileSets As Object

Dim Profiles As Object

Dim Lines As Object

Dim SegmentLength As Double

Dim Relations As Object

Dim P1(1 To 2) As Double, P2(1 To 2) As Double

Dim nSides As Integer

Dim nSide As Integer

Dim nAngle As Double

Dim nRadius As Double

Const PI = 3.14159265358979

On Error Resume Next

If InStr(1, UCase$(frmPolygon.igCommand1.Application.ActiveEnvironment), "PROFILE") > 0 Then

Set ProfileSets = igCommand1.Application.ActiveDocument.ProfileSets

Set Profiles = ProfileSets(ProfileSets.Count).Profiles

Set Profile = Profiles(1)

Set Lines = Profile.Lines2d

Set Relations = Profile.Relations2d

ElseIf InStr(1, UCase$(frmPolygon.igCommand1.Application.ActiveEnvironment), "DETAIL") > 0 Then

MsgBox igCommand1.Application.ActiveDocument.ActiveSheet

Set ProfileSets = igCommand1.Application.ActiveDocument.ActiveSheet

Set Lines = ProfileSets.Lines2d

Set Relations = ProfileSets.Relations2d

Else

MsgBox "You are not in a valid environment", vbOKOnly + vbCritical

End

End If

On Error GoTo ErrorTrap

nSides = Int(Val(frmPolygon.txtSides.Text))

If nSides < 3 Then

MsgBox "The minimum number of sides is 3", , "Polygon"

frmPolygon.txtSides.Text = 3

Exit Sub

ElseIf nSides > 20 Then

MsgBox "The maximum number of sides is 20", , "Polygon"

frmPolygon.txtSides.Text = 20

Exit Sub

End If

ReDim L(1 To nSides)

nAngle = 360# / nSides

nAngle = nAngle * PI / 180#

If frmPolygon.optDimension(0).Value = True Then

' from flat

nRadius = UOM.ParseUnit(igUnitDistance, frmPolygon.txtSize.Text)

SegmentLength = 2 * nRadius * (Tan(nAngle / 2#))

P2(1) = -(nRadius - X)

P2(2) = -((SegmentLength / 2#) - Y)

ElseIf frmPolygon.optDimension(1).Value = True Then

' point

nRadius = UOM.ParseUnit(igUnitDistance, frmPolygon.txtSize.Text)

SegmentLength = 2 * Sin(nAngle / 2) * nRadius

P2(1) = -((Cos(nAngle / 2) * nRadius) - X)

P2(2) = -((SegmentLength / 2#) - Y)

Else

' flat distance

SegmentLength = UOM.ParseUnit(igUnitDistance, frmPolygon.txtSize.Text)

P2(1) = -((SegmentLength / 2#) / (Tan(nAngle / 2#)) - X)

P2(2) = -((SegmentLength / 2#) - Y)

End If

For nSide = 0 To nSides - 1

P1(1) = P2(1)

P1(2) = P2(2)

P2(1) = P1(1) + (Sin(nAngle * nSide) * SegmentLength)

P2(2) = P1(2) + (Cos(nAngle * nSide) * SegmentLength)

Set L(nSide + 1) = Lines.AddBy2Points(P1(1), P1(2), P2(1), P2(2))

Next

If frmPolygon.chkConstrain.Value = 1 Then

For nSide = 1 To nSides

If nSide = nSides Then

Call Relations.AddKeypoint(L(nSide), igLineEnd, L(1), igLineStart)

Else

Call Relations.AddKeypoint(L(nSide), igLineEnd, L(nSide + 1), igLineStart)

Call Relations.AddEqual(L(nSide), L(nSide + 1))

End If

Next

End If

ErrorTrap:

If Err Then

cMsg = "Error # " & Str(Err.Number) & " was generated by " _

& Err.Source & Chr(13) & "( " & Err.Description & " )"

MsgBox cMsg, , "Polygon"

End

End If

End Sub

Private Sub Label3_Click()

End Sub

Private Sub optDimension_Click(Index As Integer)

imgType(0).Visible = False

imgType(1).Visible = False

imgType(2).Visible = False

imgType(Index).Visible = True

If Index = 0 Then

labType.Caption = "Radius from flat"

ElseIf Index = 1 Then

labType.Caption = "Radius from point"

ElseIf Index = 2 Then

labType.Caption = "Flat length"

End If

End Sub

Private Sub optDimension_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.labMessage.Caption = "Select the dimensioning scheme"

End Sub

Private Sub txtSides_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.labMessage.Caption = "Enter the number of sides"

End Sub

Private Sub txtSize_KeyDown(KeyCode As Integer, Shift As Integer)

If KeyCode = 13 Then

cmdCancel.SetFocus

KeyCode = 0

End If

End Sub

Private Sub txtSize_LostFocus()

Dim HexSize As Double

'Turn on error handling.

On Error Resume Next

HexSize = UOM.ParseUnit(igUnitDistance, txtSize.Text)

If Err Then

'Set focus back to text field.

txtSize.SetFocus

'Display error.

MsgBox "Invalid unit keyin"

Exit Sub

End If

'Turn off error handling.

On Error GoTo 0

'Assign correct text to the control’s Text property

txtSize.Text = UOM.FormatUnit(igUnitDistance, HexSize)

End Sub

Private Sub txtSize_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Me.labMessage.Caption = "Enter the desired dimension"

End Sub

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

Может вопрос будет казаться глупым, но на чем это :g: VB 6.0 это не компилит, как же это подсунуть в SE :sad:

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

В UG есть максоры

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

Например макросы в UG будут работать не только на стандартных действиях но н на меню которае я сам написал например на UF C++

А в вышеупомянутых примерах я сомневаюсь чтобы это было возможно обеспечить

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

в UG есть возможность записать макрос, следовательно записать полностью создение модели, потом очищаем макрос от мусора и получаем исходник модели (в CAD-ах, где есть возможность записи макроса проблем нет, а вот SE и Компас :wallbash::wallbash: )

Ссылка на сообщение
Поделиться на других сайтах
Гость
Эта тема закрыта для публикации сообщений.
  • Сейчас на странице   0 пользователей

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




  • Сообщения

    • EnKlL
      Станок Samsung Pl1600m, такарно-фрезерный, проблема с револьверной головой выдаёт ошибку "EX22831 SERVO TURRET AMP ALARM!" что это такое и что с ней делать? Невозможно сменить инструмент, не в ручную, не через MDA
    • Eng.Destructor
      Сделал так: Добавил новый формат fs2 25 0 4 0 3t #No decimal, absolute, 3 поменял  result = newfs (25, thddepth$) # изменил 16 на 25 result = newfs (25, thdfirst$) # изменил 16 на 25 result = newfs (25, thdlast$) # изменил 16 на 25 result = newfs (25, thdfinish$) # изменил 16 на 25 Спасибо за наводку
    • arsenev
    • teqn1c
      Есть динозавр stratos plus на io mb -  В нем всего 256 КБ памяти  есть ли возможность через режим rtm подгружать программу с ПК через rs 232 ? В шкафу ещё есть разъем под карту но с нее получается только считать и опять таки сохранить на память станка. Соединение ПК-станок настроил ,есть возможность отправлять на него через альфакам программы ,но они сохраняются в память станка. В альфакам есть непрерывная отправка - она отправляет - но в режиме rtm ничего не происходит 
    • Metal_Cutter
      @arsenev В FC такого нет.
    • Bot
      HCL CAMWorks 2024, новая версия программного обеспечения CAM, полностью интегрированного с SOLIDWORKS и Solid Edge включает в себя передовые технологии, позволяющие сократить время программирования, уменьшить время цикла обработки и увеличить срок службы инструмента. Смотреть полностью
    • Александр1979
      Руководство для дусь взял здесь: https://www.cnczone.com/forums/daewoo-doosan/413426-every-doosan-service-manual-currently-auto-updated.html
    • ss_162
      Может есть у кого оригинальные резцы на продажу? Нужен резец SFCC 50 - это маркировка D`Andrea, или Искаровский, он такой же, только маркировка у него другая.
    • Aveovar
      Подскажи, как ты сделал несколько экранов с разных ракурсов
    • Kaktusito
      Всем доброго времени суток! Только начал заниматься редактированием постпроцессоров и сразу же столкнулся с проблемой. Суть в том что я нашел по форумам постпроцессоры с SolidCAM 2015 года, ибо у меня в версии 2022 года их почти нет, а мне нужен был более менее адекватный пост под токарку.  Закинул все файлы Gpptool 2015 года в свою папку, выбрал подходящий мне станок и начал генерировать УП.  Как вы поняли ничего мне не сгенерировало. Пишет ошибку "please change the name "Bore" in the VMID. This name is reserved for use in the GPP"  Сделал то что просит ошибка и был уверен что это не поможет, так оно и вышло. По итогу начало долбить другие ошибки. Очень еще не понятно с файлами которые я кидал в папку Gpptool потому что вместо стандартных двух у меня их аж 4 штуки.: gpp с циклами, gpp обычный, PRP и vmid. Хотя я знаю что в версиях вроде после 2017 уже идет по 2 файла. Что я только не пробовал кидал только 2 файла, кидал все 4, кидал содержимое файла с циклами в основной gpp, шёл по пути ошибок и исправлял что меня просили. В общем ничего не помогает  От безисходности пишу сюда, вы моя последняя надежда понять что происходит и почему ничего не работает. Заранее благодарю за ответы!
×
×
  • Создать...