AnsweredAssumed Answered

why this simple macro draw a wrong point while the coordinates are correct?

Question asked by Yijin Mao on Nov 19, 2014
Latest reply on Nov 20, 2014 by Yijin Mao

Option Explicit

 

Dim swApp As SldWorks.SldWorks

Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Const depth As Double = "150e-3"

Const H As Double = "12.7e-3"

Const L As Double = "6e-3"

Const ratioH As Double = "0.3"

Const ratioL As Double = "0.5"

Const ratioHGap As Double = "0.2"

Dim H1 As Double

Dim L1 As Double

Dim H2 As Double

Dim L2 As Double

 

 

Dim P4x As Double, P4y As Double, P4z As Double

Dim P5x As Double, P5y As Double, P5z As Double

Dim P6x As Double, P6y As Double, P6z As Double

 

 

Sub main()

 

 

H1 = ratioH * H

L1 = ratioL * L

H2 = (1 - ratioH - ratioHGap) * H

L2 = L1 * H2 / (H - H1)

 

 

P4x = L

P4y = H2

P4z = 0

 

 

P5x = L - L2

P5y = H2

P5z = 0

 

 

P6x = L

P6y = 0

P6z = 0

 

 

Set swApp = Application.SldWorks

 

' use your own template

Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2013\templates\Part.prtdot", 0, 0, 0)

swApp.ActivateDoc2 "wedgelockPart2", False, longstatus

Set Part = swApp.ActiveDoc

Dim myModelView As Object

Set myModelView = Part.ActiveView

myModelView.FrameLeft = 0

myModelView.FrameTop = 21

Set myModelView = Part.ActiveView

myModelView.FrameWidth = 1291

myModelView.FrameHeight = 585

boolstatus = Part.Extension.SelectByID2("Front Plane", "PLANE", 0, 0, 5, False, 0, Nothing, 0)

Part.SketchManager.InsertSketch True

Part.ClearSelection2 True

Dim skSegment As Object

 

' P4

Set skSegment = Part.SketchManager.CreateLine(P4x, P4y, P4z, P5x, P5y, P5z)

' P5

Set skSegment = Part.SketchManager.CreateLine(P5x, P5y, P5z, P6x, P6y, P6z)

' P6

Set skSegment = Part.SketchManager.CreateLine(P6x, P6y, P6z, P4x, P4y, P4z)

 

' this two are same

' however the real one in the generated drawing is not same

Debug.Print P4x

Debug.Print P6x

 

 

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

Part.ShowNamedView2 "*Trimetric", 8

Part.ClearSelection2 True

boolstatus = Part.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 4, Nothing, 0)

 

 

Dim myFeature As Object

 

 

Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, depth, depth, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)

Part.SelectionManager.EnableContourSelection = False

 

 

Part.ShowNamedView2 "*Front", 1

Part.ViewZoomtofit2

 

 

End Sub

Outcomes