×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Sketch macro
4

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.

RE: Sketch macro

4
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")
    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

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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources