Sketch macro
Sketch macro
(OP)
This is for SW and VB masters out there:
I would like to write a macro that does the following:
1. User selects 4 sketch points
2. Runs macro
3. Coordinates of first an second point are compared
4. If first and second point are more likely to be horizontal, a horizontal constraint is applied to them otherwise vertical
5. Points 2 and 3: if horizontal was applied at 4 apply vertical, otherwise apply horizontal
6. Points 3 and 4: apply whatever was applied at 4
7. Points 4 and 1: apply whatever was applied at 5.
I would really appreciate any help.
I would like to write a macro that does the following:
1. User selects 4 sketch points
2. Runs macro
3. Coordinates of first an second point are compared
4. If first and second point are more likely to be horizontal, a horizontal constraint is applied to them otherwise vertical
5. Points 2 and 3: if horizontal was applied at 4 apply vertical, otherwise apply horizontal
6. Points 3 and 4: apply whatever was applied at 4
7. Points 4 and 1: apply whatever was applied at 5.
I would really appreciate any help.






RE: Sketch macro
Dim swApp As Object
Dim Doc As Object
Dim SelMgr As Object
Dim PtOne, PtTwo As Object
Dim Msg As String
Dim LongStatus, i As Long
Const NUMSKETCHPOINTS As Integer = 4
Const swDocPART = 1
Const swMbWarning = 1
Const swMbOk = 2
Const swSelSKETCHPOINTS = 11
Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set Doc = swApp.ActiveDoc
Set SelMgr = Doc.SelectionManager()
If ((Doc Is Nothing) Or (Doc.GetActiveSketch Is Nothing)) Then
Msg = "A sketch must be active to use this command!"
LongStatus = swApp.SendMsgToUser2(Msg, swMbWarning, swMbOk)
Exit Sub
ElseIf (SelMgr.GetSelectedObjectCount <> NUMSKETCHPOINTS) Then
Msg = "Please select " & NUMSKETCHPOINTS & " sketch points!"
LongStatus = swApp.SendMsgToUser2(Msg, swMbWarning, swMbOk)
Exit Sub
Else
For i = 1 To SelMgr.GetSelectedObjectCount
If (SelMgr.GetSelectedObjectType2(i) <> swSelSKETCHPOINTS) Then
Msg = "This command can only be used with sketch points!"
LongStatus = swApp.SendMsgToUser2(Msg, swMbWarning, swMbOk)
Exit Sub
End If
Next i
Set PtOne = SelMgr.GetSelectedObject4(1)
Set PtTwo = SelMgr.GetSelectedObject4(2)
Set PtThree = SelMgr.GetSelectedObject4(3)
Set PtFour = SelMgr.GetSelectedObject4(4)
If (Abs(PtTwo.x - PtOne.x) < Abs(PtTwo.y - PtOne.y)) Then
Msg = "Point1 - Point2 => vertical"
Else
Msg = "Point1 - Point2 => horizontal"
End If
LongStatus = swApp.SendMsgToUser2(Msg, swMbWarning, swMbOk)
End If
End Sub
RE: Sketch macro
A red star for you.