Calculate Closest Distance Between Model Components Example (VBA)
This example shows how to calculate the closest distance between two
components.
'------------------------------------------
'
' Preconditions: Select both components by placing a point
on each of them.
'
' Postconditions: A 3D sketch is created using the selection
points and the
' distance
between the components calculated.
'
'--------------------------------------------
Option Explicit
Public Enum swSelectType_e
swSelNOTHING
= 0
swSelEDGES
= 1 '
"EDGE"
swSelFACES
= 2 '
"FACE"
swSelVERTICES
= 3 '
"VERTEX"
swSelDATUMPLANES
= 4 '
"PLANE"
swSelDATUMAXES
= 5 '
"AXIS"
swSelDATUMPOINTS
= 6 '
"DATUMPOINT"
swSelOLEITEMS
= 7 '
"OLEITEM"
swSelATTRIBUTES
= 8 '
"ATTRIBUTE"
swSelSKETCHES
= 9 '
"SKETCH"
swSelSKETCHSEGS
= 10 '
"SKETCHSEGMENT"
swSelSKETCHPOINTS
= 11 '
"SKETCHPOINT"
swSelDRAWINGVIEWS
= 12 '
"DRAWINGVIEW"
swSelGTOLS
= 13 '
"GTOL"
swSelDIMENSIONS
= 14 '
"DIMENSION"
swSelNOTES
= 15 '
"NOTE"
swSelSECTIONLINES
= 16 '
"SECTIONLINE"
swSelDETAILCIRCLES
= 17 '
"DETAILCIRCLE"
swSelSECTIONTEXT
= 18 '
"SECTIONTEXT"
swSelSHEETS
= 19 '
"SHEET"
swSelCOMPONENTS
= 20 '
"COMPONENT"
swSelMATES
= 21 '
"MATE"
swSelBODYFEATURES
= 22 '
"BODYFEATURE"
swSelREFCURVES
= 23 '
"REFCURVE"
swSelEXTSKETCHSEGS
= 24 '
"EXTSKETCHSEGMENT"
swSelEXTSKETCHPOINTS
= 25 '
"EXTSKETCHPOINT"
swSelHELIX
= 26 '
"HELIX"
(is this wrong?)
swSelREFERENCECURVES
= 26 '
"REFERENCECURVES"
swSelREFSURFACES
= 27 '
"REFSURFACE"
swSelCENTERMARKS
= 28 '
"CENTERMARKS"
swSelINCONTEXTFEAT
= 29 '
"INCONTEXTFEAT"
swSelMATEGROUP
= 30 '
"MATEGROUP"
swSelBREAKLINES
= 31 '
"BREAKLINE"
swSelINCONTEXTFEATS
= 32 '
"INCONTEXTFEATS"
swSelMATEGROUPS
= 33 '
"MATEGROUPS"
swSelSKETCHTEXT
= 34 '
"SKETCHTEXT"
swSelSFSYMBOLS
= 35 '
"SFSYMBOL"
swSelDATUMTAGS
= 36 '
"DATUMTAG"
swSelCOMPPATTERN
= 37 '
"COMPPATTERN"
swSelWELDS
= 38 '
"WELD"
swSelCTHREADS
= 39 '
"CTHREAD"
swSelDTMTARGS
= 40 '
"DTMTARG"
swSelPOINTREFS
= 41 '
"POINTREF"
swSelDCABINETS
= 42 '
"DCABINET"
swSelEXPLVIEWS
= 43 '
"EXPLODEDVIEWS"
swSelEXPLSTEPS
= 44 '
"EXPLODESTEPS"
swSelEXPLLINES
= 45 '
"EXPLODELINES"
swSelSILHOUETTES
= 46 '
"SILHOUETTE"
swSelCONFIGURATIONS
= 47 '
"CONFIGURATIONS"
swSelOBJHANDLES
= 48
swSelARROWS
= 49 '
"VIEWARROW"
swSelZONES
= 50 '
"ZONES"
swSelREFEDGES
= 51 '
"REFERENCE-EDGE"
swSelREFFACES
= 52
swSelREFSILHOUETTE
= 53
swSelBOMS
= 54 '
"BOM"
swSelEQNFOLDER
= 55 '
"EQNFOLDER"
swSelSKETCHHATCH
= 56 '
"SKETCHHATCH"
swSelIMPORTFOLDER
= 57 '
"IMPORTFOLDER"
swSelVIEWERHYPERLINK
= 58 '
"HYPERLINK"
swSelMIDPOINTS
= 59
swSelCUSTOMSYMBOLS
= 60 '
"CUSTOMSYMBOL"
swSelCOORDSYS
= 61 '
"COORDSYS"
swSelDATUMLINES
= 62 '
"REFLINE"
swSelROUTECURVES
= 63
swSelBOMTEMPS
= 64 '
"BOMTEMP"
swSelROUTEPOINTS
= 65 '
"ROUTEPOINT"
swSelCONNECTIONPOINTS
= 66 '
"CONNECTIONPOINT"
swSelROUTESWEEPS
= 67
swSelPOSGROUP
= 68 '
"POSGROUP"
swSelBROWSERITEM
= 69 '
"BROWSERITEM"
swSelFABRICATEDROUTE
= 70 '
"ROUTEFABRICATED"
swSelSKETCHPOINTFEAT
= 71 '
"SKETCHPOINTFEAT"
swSelEMPTYSPACE
= 72 '
(is this
wrong?)
swSelCOMPSDONTOVERRIDE
= 72
swSelLIGHTS
= 73 '
"LIGHTS"
swSelWIREBODIES
= 74
swSelSURFACEBODIES
= 75 '
"SURFACEBODY"
swSelSOLIDBODIES
= 76 '
"SOLIDBODY"
swSelFRAMEPOINT
= 77 '
"FRAMEPOINT"
swSelSURFBODIESFIRST
= 78
swSelMANIPULATORS
= 79 '
"MANIPULATOR"
swSelPICTUREBODIES
= 80 '
"PICTURE
BODY"
swSelSOLIDBODIESFIRST
= 81
swSelDOWELSYMS
= 86 '
"DOWELSYM"
swSelEXTSKETCHTEXT
= 88 '
"EXTSKETCHTEXT"
swSelBLOCKINST
= 93 '
"BLOCKINST"
swSelFTRFOLDER
= 94 '
"FTRFOLDER"
swSelSKETCHREGION
= 95 '
"SKETCHREGION"
swSelSKETCHCONTOUR
= 96 '
"SKETCHCONTOUR"
swSelBOMFEATURES
= 97 '
"BOMFEATURE"
swSelANNOTATIONTABLES
= 98 '
"ANNOTATIONTABLES"
swSelBLOCKDEF
= 99 '
"BLOCKDEF"
swSelCENTERMARKSYMS
= 100 '
"CENTERMARKSYMS"
swSelCENTERLINES
= 103 '
"CENTERLINE"
swSelHOLETABLEFEATS
= 104 '
"HOLETABLE"
swSelHOLETABLEAXES
= 105 '
"HOLETABLEAXIS"
swSelWELDMENT
= 106 '
"WELDMENT"
swSelSUBWELDFOLDER
= 107 '
"SUBWELDMENT"
swSelEXCLUDEMANIPULATORS
= 111
swSelREVISIONTABLE
= 113 '
"REVISIONTABLE"
swSelBODYFOLDER
= 118 '
"BDYFOLDER"
End Enum
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swSelObj1 As
Object
Dim
swSelObj2 As
Object
Dim
vPt1 As
Variant
Dim
vPt2 As
Variant
Dim
nDist As
Double
Dim
swSkPoint1 As
SldWorks.SketchPoint
Dim
swSkPoint2 As
SldWorks.SketchPoint
Dim
swSkLine As
SldWorks.SketchLine
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swSelObj1 = swSelMgr.GetSelectedObject5(1)
Set
swSelObj2 = swSelMgr.GetSelectedObject5(2)
nDist
= swModel.ClosestDistance(swSelObj1,
swSelObj2, vPt1, vPt2)
Debug.Assert
nDist > 0#
Debug.Assert
Not IsEmpty(vPt1)
Debug.Assert
Not IsEmpty(vPt2)
Debug.Print
"File = " & swModel.GetPathName
Debug.Print
" SelType1
= " & swSelMgr.GetSelectedObjectType2(1)
Debug.Print
" SelType2
= " & swSelMgr.GetSelectedObjectType2(2)
Debug.Print
" Pt1
=
(" & vPt1(0) * 1000# & ", " & vPt1(1) * 1000#
& ", " & vPt1(2) * 1000# & ") mm"
Debug.Print
" Pt2
=
(" & vPt2(0) * 1000# & ", " & vPt2(1) * 1000#
& ", " & vPt2(2) * 1000# & ") mm"
Debug.Print
" Dist
=
" & nDist * 1000# & " mm"
swModel.SetAddToDB True
swModel.Insert3DSketch2 False
Set
swSkPoint1 = swModel.CreatePoint2(vPt1(0),
vPt1(1), vPt1(2))
Set
swSkPoint2 = swModel.CreatePoint2(vPt2(0),
vPt2(1), vPt2(2))
Set
swSkLine = swModel.CreateLine2(vPt1(0),
vPt1(1), vPt1(2), vPt2(0), vPt2(1), vPt2(2))
swModel.SetAddToDB False
swModel.Insert3DSketch2 True
End Sub
'------------------------------------------