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

[Jackal2004 0]

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

Изменено 7 августа 2003 пользователем Jackal2004

[MikeS 1]

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

[Jackal2004 0]

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

[MikeS 1]

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

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

[Jackal2004 0]

Все правильно, только 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

или для 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

Изменено 7 августа 2003 пользователем Jackal2004

[Jackal2004 0]

Остался только SE и прибавился Компас

[ART 511]

Jackal2004

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

[Jackal2004 0]

Хотя бы маленький примерчик цилиндр там или куб на VB под SE 12

[ART 511]

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

[Jackal2004 0]

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

[nut888 3]

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

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

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

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

[Jackal2004 0]

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

[Jackal2004 0]

2 ART

и все же как это подсунуть SE

[Jackal2004 0]

2 Moderator

Ну чтож если сегодня никто не ответит, то можно считать тему закрытой