Solidworks Sketch > Custom GTOL Symbol Convertor

Library for macros
User avatar
Rob
Posts: 128
Joined: Mon Mar 08, 2021 3:46 pm
Answers: 2
Location: Mighty Glossop, UK
x 787
x 208
Contact:

Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by Rob »

This project was inspired by this passage from matt in his excellent 2013 Bible
The attachment image.png is no longer available
It will analyse sketches and copy the code to the clipboard ready for you to paste into a text document or your gtol.sym file.

For example the below sketch will create the code shown
The attachment image.png is no longer available
The attachment image.png is no longer available

A few points to note
  • It will ignore a sketch called Bounding Box Sketch which is a 1x1 Rectangle with bottom left at origin.
  • You should create your symbol in a new sketch and the bounding box sketch shows you the 1 x 1 box you are working in.
    By the way you are free to go beyond these limits but then your symbol will be big. (but maybe that's what you want)
  • You can name your sketches to name your symbols
  • For the special case of a Solid Arc you can use construction geometry
  • Remember to backup your Gtol.sym file before changing anything
I'd like to add text support to this and also make it possible to select sketches individually.

I'll get round to it one day... or maybe you'd like to do that

Macro and 2016 bounding box part in attached zip
Attachments
Symbol.zip
(49.69 KiB) Downloaded 222 times
User avatar
mattpeneguy
Posts: 1386
Joined: Tue Mar 09, 2021 11:14 am
Answers: 4
x 2489
x 1899

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by mattpeneguy »

Nice work Rob. We have custom bugs for our drawings based on old 2D CAD. I'll bookmark this for future reference.
User avatar
matt
Posts: 1589
Joined: Mon Mar 08, 2021 11:34 am
Answers: 19
Location: Virginia
x 1219
x 2373
Contact:

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by matt »

Rob wrote: Sat Mar 13, 2021 3:28 am This project was inspired by this passage from matt in his excellent 2013 Bible

image.png
...
You know, when I wrote that, I was a younger man with more time on my hands. I never really expected anybody would do anything with this. I just wanted to get down this little bit of arcane knowledge before people forgot about it. Congratulations on making something useful out of this information!
tommyLi
Posts: 1
Joined: Thu Aug 31, 2023 11:59 pm
Answers: 0
x 14
x 1

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by tommyLi »

Rob, unable to unpack archive: "Unexpected end of file."
I try again and again - no result.
User avatar
josh
Posts: 295
Joined: Thu Mar 11, 2021 1:05 pm
Answers: 16
x 22
x 508

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by josh »

@Rob @matt there seems to be some issue with the website download... I just tried it and I get an error that the zip file is corrupt. Maybe re-upload by Rob?

Rob, I was about to try to write one of these one day, but realized I couldn't figure out how to tell which way a sketched arc was going (CW or CCW) to translate to the format for the gtol... (which I think is always CCW?) Then the other day I realized how to do it (even in 3 dimension sketches), but I couldn't remember what I was trying to do when I couldn't figure it out before. :D This post popping back to the top reminded me why I was trying to figure it out, but also makes it unneccessary for me to write the thing I was trying to figure it out for. :lol: I'm curious to check this out and see how you dunnit.
User avatar
matt
Posts: 1589
Joined: Mon Mar 08, 2021 11:34 am
Answers: 19
Location: Virginia
x 1219
x 2373
Contact:

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by matt »

josh wrote: Sun Sep 03, 2023 8:16 pm @Rob @matt there seems to be some issue with the website download... I just tried it and I get an error that the zip file is corrupt. Maybe re-upload by Rob?

Rob, I was about to try to write one of these one day, but realized I couldn't figure out how to tell which way a sketched arc was going (CW or CCW) to translate to the format for the gtol... (which I think is always CCW?) Then the other day I realized how to do it (even in 3 dimension sketches), but I couldn't remember what I was trying to do when I couldn't figure it out before. :D This post popping back to the top reminded me why I was trying to figure it out, but also makes it unneccessary for me to write the thing I was trying to figure it out for. :lol: I'm curious to check this out and see how you dunnit.
There was an issue early in the life of the site where we lost some attachment data. This is one of the posts that was effected. I've not been able to recover the data. Sorry.
User avatar
josh
Posts: 295
Joined: Thu Mar 11, 2021 1:05 pm
Answers: 16
x 22
x 508

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by josh »

Hopefully Rob will see this and reupload.... :D
User avatar
Rob
Posts: 128
Joined: Mon Mar 08, 2021 3:46 pm
Answers: 2
Location: Mighty Glossop, UK
x 787
x 208
Contact:

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by Rob »

Hi Guys

Sorry just seen this.

It was a long long time ago I wrote this.. believe it or not my first solution involved saving as as iges and I had an excel spreadsheet that parsed it and outputted the code.

This was one of the first projects I did when learning the api and VBA. I daren't even look at the code but I remember it worked perfect.

Instead of uploading the macro I'll post the code here

Code: Select all

' Macro to create custom symbols from sketches
' v1.1 by 369
'
';;  SolidWorks
';;
';;  Geometric Tolerancing Symbols Library.
';;
';;  Format:
';;
';;      #<Name of library>,<Description of library>
';;      *<Name of symbol>,<Description of symbol>
';;      A,LINE xStart,yStart,xEnd,yEnd
';;      A,CIRCLE xCenter,yCenter,radius
';;      A,ARC xCenter,yCenter,radius,startAngle,endAngle
';;      A,SARC xCenter,yCenter,radius,startAngle,endAngle
';;      A,TEXT xLowerLeft,yLowerLeft,<letter(s)>
';;      A,POLY x1,y1,x2,y2,x3,y3
';;
';;  Units:
';;
';;      All x, y, and radius values are in the symbols grid space (0.0 to 1.0),
';;      where 0,0 is the lower left corner and 1,1 is the upper right corner.
';;      The grid space is considered to be the height of a character squared.
';;      All angle values are in degrees.
';;
'
'
'
'
'
'
'
'
'
'

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeatFolder As SldWorks.FeatureFolder
Dim swFeature As SldWorks.Feature
Dim swSketchMgr As SldWorks.SketchManager
Dim swSketch As Sketch
Dim vSketchSegments As Variant
Dim vSketchSegment As Variant
Dim swSketchSegment As SldWorks.SketchSegment
Dim swSketchLine As SldWorks.SketchLine
Dim swSketchArc As SldWorks.SketchArc
Dim swStartSketchPoint As SldWorks.SketchPoint
Dim swEndSketchPoint As SldWorks.SketchPoint
Dim swCenterSketchPoint As SldWorks.SketchPoint
Dim swSketchText As SldWorks.SketchText
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long


Function get_angle(x As Double, y As Double) As Double

    Rem Returns the angle in degrees of the x,y point from the origin, with zero degrees at 3 O'Clock going Clockwise

    Dim Angle As Double
    Dim PI As Double
    PI = 4 * Atn(1)
    
    If x = 0 Then
        Angle = PI / 2
    Else
        Angle = Atn(Abs(y) / Abs(x))
    End If
    
    If x < 0 Then
        If y < 0 Then
            Angle = PI + Angle
        Else
            Angle = PI - Angle
        End If
    Else
        If y < 0 Then
            Angle = 2 * PI - Angle
        Else
            'Angle = Angle
        End If
    End If
    
    get_angle = (Angle * 180) / PI
    
End Function

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc
Set swSketchMgr = swModel.SketchManager

swModel.ClearSelection2 True

Dim sCode As String
sCode = ""

Dim sName As String
Dim sFeatType As String

Dim xStart, xEnd, xCenter As Double
Dim yStart, yEnd, yCenter As Double
Dim startAngle, endAngle As Double

sCode = sCode & ";;" & vbCr
sCode = sCode & ";; ---------------------------------------------------------------------------" & vbCr
sCode = sCode & ";;" & vbCr
sCode = sCode & ";;                               Custom Symbols" & vbCr
sCode = sCode & ";;" & vbCr


Set swFeature = swModel.FirstFeature

While Not swFeature Is Nothing 'we have a feature

    If swFeature.GetTypeName2 = "FtrFolder" Then
        If InStr(1, swFeature.Name, "EndTag", vbTextCompare) Then
            sCode = sCode & ";;" & vbCr
        Else
            sCode = sCode & "#" & swFeature.Name & "," & swFeature.Description & " description" & vbCr
        End If
    End If

    If swFeature.GetTypeName2 = "ProfileFeature" Then
        
        Set swSketch = swFeature.GetSpecificFeature2
        
        If swSketch.Name = "Bounding Box Sketch" Then
            'ignore
        Else
        
            sCode = sCode & "*" & swSketch.Name & "," & swSketch.Description & vbCr 'Symbol Name
            
            vSketchSegments = swSketch.GetSketchSegments
    
            If (Not IsEmpty(vSketchSegments)) Then
            
                For Each vSketchSegment In vSketchSegments
                
                    Set swSketchSegment = vSketchSegment
    
                    Select Case (swSketchSegment.GetType)
    
                        Case swSketchSegments_e.swSketchText
                            Set swSketchText = vSketchSegment
                            
                                Dim vCoordinates As Variant
                                vCoordinates = swSketchText.GetCoordinates()
                            
                                sCode = sCode & "A,TEXT " & FormatNumber(CStr(vCoordinates(0) * 1000), 4) & ", " _
                                                          & FormatNumber(CStr(vCoordinates(1) * 1000), 4) & ", " _
                                                          & swSketchText.Text & vbCr
                            
        
                        Case swSketchSegments_e.swSketchLine
                            If swSketchSegment.ConstructionGeometry Then 'do nothing
                            Else
                                Set swSketchLine = swSketchSegment
                                Set swStartSketchPoint = swSketchLine.GetStartPoint2
                                Set swEndSketchPoint = swSketchLine.GetEndPoint2
                                
                                xStart = swStartSketchPoint.x * 1000
                                yStart = swStartSketchPoint.y * 1000
                                
                                xEnd = swEndSketchPoint.x * 1000
                                yEnd = swEndSketchPoint.y * 1000
                                
                                sCode = sCode & "A,LINE " & FormatNumber(CStr(xStart), 4) & "," & FormatNumber(CStr(yStart), 4) & "," & FormatNumber(CStr(xEnd), 4) & "," & FormatNumber(CStr(yEnd), 4) & vbCr
                            End If
                          
                        Case swSketchSegments_e.swSketchELLIPSE
                            sCode = sCode & ";; Ellipse Ignored" & vbCr
                            
                        Case swSketchSegments_e.swSketchArc
                            
                            Set swSketchArc = swSketchSegment
                            
                            Set swCenterSketchPoint = swSketchArc.GetCenterPoint2
 
                            xCenter = swCenterSketchPoint.x * 1000
                            yCenter = swCenterSketchPoint.y * 1000
                            
                            Dim dRadius As Double
                               dRadius = swSketchArc.GetRadius * 1000

                            If swSketchArc.IsCircle Then
                                If swSketchSegment.ConstructionGeometry Then
                                     sCode = sCode & "A,SARC " & FormatNumber(CStr(xCenter), 4) & "," & FormatNumber(CStr(yCenter), 4) & "," & FormatNumber(CStr(dRadius), 4) & "," & FormatNumber(CStr(0), 4) & "," & FormatNumber(CStr(180), 4) & vbCr
                                     sCode = sCode & "A,SARC " & FormatNumber(CStr(xCenter), 4) & "," & FormatNumber(CStr(yCenter), 4) & "," & FormatNumber(CStr(dRadius), 4) & "," & FormatNumber(CStr(179), 4) & "," & FormatNumber(CStr(1), 4) & vbCr
                                Else
                                    sCode = sCode & "A,CIRCLE " & FormatNumber(CStr(xCenter), 4) & "," & FormatNumber(CStr(yCenter), 4) & "," & FormatNumber(CStr(dRadius), 4) & vbCr
                                End If
                                
                            Else 'partial arc
                                    
                                If swSketchArc.GetRotationDir = 1 Then 'Anti-Clockwise
                                    Set swStartSketchPoint = swSketchArc.GetStartPoint2
                                    Set swEndSketchPoint = swSketchArc.GetEndPoint2
                                
                                Else 'Clockwise - engage reverse gear!
                                    Set swStartSketchPoint = swSketchArc.GetEndPoint2
                                    Set swEndSketchPoint = swSketchArc.GetStartPoint2
                                
                                End If
                                 
                                xStart = swStartSketchPoint.x * 1000 - xCenter
                                yStart = swStartSketchPoint.y * 1000 - yCenter
                                 
                                xEnd = swEndSketchPoint.x * 1000 - xCenter
                                yEnd = swEndSketchPoint.y * 1000 - yCenter
                               
                                startAngle = get_angle((xStart), (yStart))
                                endAngle = get_angle((xEnd), (yEnd))
                                                                               
                                If swSketchSegment.ConstructionGeometry Then
                                     sCode = sCode & "A,SARC " & FormatNumber(CStr(xCenter), 4) & "," & FormatNumber(CStr(yCenter), 4) & "," & FormatNumber(CStr(dRadius), 4) & "," & FormatNumber(CStr(startAngle), 4) & "," & FormatNumber(CStr(endAngle), 4) & vbCr
                                Else
                                    sCode = sCode & "A,ARC " & FormatNumber(CStr(xCenter), 4) & "," & FormatNumber(CStr(yCenter), 4) & "," & FormatNumber(CStr(dRadius), 4) & "," & FormatNumber(CStr(startAngle), 4) & "," & FormatNumber(CStr(endAngle), 4) & vbCr
                                End If
                               
                            End If
                      
                           
                        'Case swSketchSegments_e.swSketchPARABOLA
                        'Case swSketchSegments_e.swSketchSPLINE
                        'Case Else
                    End Select
    
                
                Next vSketchSegment
            End If
        End If
    
    End If
    Set swFeature = swFeature.GetNextFeature()
    
Wend


Dim DataObj As New MSForms.DataObject

'Put a string in the clipboard
DataObj.SetText sCode
DataObj.PutInClipboard
MsgBox "Code Copied To Clipboard"


End Sub


User avatar
Rob
Posts: 128
Joined: Mon Mar 08, 2021 3:46 pm
Answers: 2
Location: Mighty Glossop, UK
x 787
x 208
Contact:

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by Rob »

Oh here's an example file I had.. so I include the macro as well
Attachments
Symbol Generator.swp
(56.5 KiB) Downloaded 125 times
Symbol Sketches.SLDPRT
(38.04 KiB) Downloaded 124 times
User avatar
josh
Posts: 295
Joined: Thu Mar 11, 2021 1:05 pm
Answers: 16
x 22
x 508

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by josh »

This came to my mind today due to a post on the main SW forum... Here's a little companion macro to force SW to re-read GTOL.SYM so you can see changes you're making easier.


Sub main()
Dim sCurrent As String
Dim swApp As SldWorks.SldWorks
Set swApp = Application.SldWorks
sCurrent = swApp.GetUserPreferenceStringValue(swUserPreferenceStringValue_e.swFileLocationsSymbolLibraryFolder)
swApp.SetUserPreferenceStringValue swUserPreferenceStringValue_e.swFileLocationsSymbolLibraryFolder, sCurrent
End Sub
User avatar
josh
Posts: 295
Joined: Thu Mar 11, 2021 1:05 pm
Answers: 16
x 22
x 508

Re: Solidworks Sketch > Custom GTOL Symbol Convertor

Unread post by josh »

So I couldn't stop myself... I made a couple tweaks and added a userform.
Sketch text position is specified as the center of the text, so this code calculates that center.
Solid fill is possible by creating triangular sections of boundary hatch.
Attachments
GTOL_Maker.swp
(131 KiB) Downloaded 64 times
Post Reply