Sketch macro 4

[dogarila]

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.

 

[Stoker]

This should get you started

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&quot
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 = &quot;Please select &quot; & NUMSKETCHPOINTS & &quot; sketch points!&quot;
LongStatus = swApp.SendMsgToUser2(Msg, swMbWarning, swMbOk)
Exit Sub

Else
For i = 1 To SelMgr.GetSelectedObjectCount
If (SelMgr.GetSelectedObjectType2(i) <> swSelSKETCHPOINTS) Then
Msg = &quot;This command can only be used with sketch points!&quot;
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 = &quot;Point1 - Point2 => vertical&quot;
Else
Msg = &quot;Point1 - Point2 => horizontal&quot;
End If

LongStatus = swApp.SendMsgToUser2(Msg, swMbWarning, swMbOk)

End If

End Sub

 

[dogarila]

Thank you, Stoker. That's exactly what I need.
A red star for you.