Creating Plane Parallel to current view-point

I know there used to be a macro available for this but I couldn't get to it. So if anyone is interested I created a new one today here is the code. I wanted the plane so that I can project onto faces so that I can apply a hatch to a surface that is partially hidden. Anyway here is the code. What a stuborn wh@re the math utility is. I had to create a point array and then pass it to a variant for the darn thing to work right.

Sub main() 'Create a plane parallel to the current view 'written in it's entirety by Corey Scheich 'No warranty is expressed or implied 'I will not be held responsible if this code renders anything 'useless. Use it at your own risk.

Dim swApp As SldWorks.SldWorks Dim Model As SldWorks.ModelDoc2 Dim ThisView As SldWorks.ModelView Dim ViewTransform As SldWorks.MathTransform Dim MathUtil As SldWorks.MathUtility Dim Point1 As SldWorks.MathPoint Dim Point2 As SldWorks.MathPoint Dim Point3 As SldWorks.MathPoint Dim dPoint(2) As Double Dim vPoint As Variant Dim NewPlane As SldWorks.refPlane

Set swApp = Application.SldWorks Set Model = swApp.ActiveDoc Set ThisView = Model.ActiveView Set MathUtil = swApp.GetMathUtility

dPoint(0) = 0 dPoint(1) = 0 dPoint(2) = 0

vPoint = dPoint

Set Point1 = MathUtil.CreatePoint((vPoint)) Point1.ArrayData = vPoint dPoint(0) = 1 dPoint(1) = 0 dPoint(2) = 0

vPoint = dPoint

Set Point2 = MathUtil.CreatePoint((vPoint))

dPoint(0) = 0 dPoint(1) = 1 dPoint(2) = 0

vPoint = dPoint

Set Point3 = MathUtil.CreatePoint((vPoint))

Set ViewTransform = ThisView.Orientation3 'change from (model to view) to (view to model) Set ViewTransform = ViewTransform.Inverse 'transform the points Set Point1 = Point1.MultiplyTransform(ViewTransform) Set Point2 = Point2.MultiplyTransform(ViewTransform) Set Point3 = Point3.MultiplyTransform(ViewTransform)

'Create the plane Set NewPlane = Model.CreatePlaneFixed2( _ Point1.ArrayData, _ Point2.ArrayData, _ Point3.ArrayData, _ True) 'Unhide the plane Model.UnBlankRefGeom

End Sub

Reply to
Corey Scheich
Loading thread data ...

This code I found some time ago. Perhaps the one you couldn't find?

----------------------------------------------- Option Explicit

Sub main() Dim swApp As Object Dim modelDoc As Object Dim modelView As Object Dim ori As Variant Dim pt1(0 To 2) As Double Dim pt2(0 To 2) As Double Dim pt3(0 To 2) As Double Dim ptv1 As Variant Dim ptv2 As Variant Dim ptv3 As Variant Dim X As Double Dim Y As Double Dim Z As Double Dim Units As Integer Dim conversion As Double Dim selMgr As Object Dim retval As Boolean

Set swApp = CreateObject("SldWorks.Application") Set modelDoc = swApp.ActiveDoc Set modelView = modelDoc.ActiveView

Units = modelDoc.LengthUnit Select Case Units Case 0 ' mm conversion = 1000 Case 1 ' cm conversion = 100 Case 2 ' m conversion = 1 Case 3 ' in conversion = 39.36996 Case 4 ' ft conversion = 3.28083 Case 5 ' ft-in conversion = 39.36996 End Select ' Orientation2 ' 0 1 2 3 ' 4 5 6 7 ' 8 9 10 11 ori = modelView.Orientation2

' origin (0, 0, 0) pt1(0) = 0 pt1(1) = 0 pt1(2) = 0

' x axis (1, 0, 0) pt2(0) = ori(0) / conversion pt2(1) = ori(4) / conversion pt2(2) = ori(8) / conversion

' y axis (0, 1, 0) pt3(0) = ori(1) / conversion pt3(1) = ori(5) / conversion pt3(2) = ori(9) / conversion ptv1 = pt1 ptv2 = pt2 ptv3 = pt3 ' create plane thru 3 points retval = modelDoc.CreatePlaneFixed((ptv1), (ptv2), (ptv3), False) If Not retval Then MsgBox (retval) End

-----------------------------------------------

/Anders

Reply to
bagarnx

Whoever wrote that had a better understanding of the orientation matrix than I do. It doesn't look as complex as I thought though.

Corey

Reply to
Corey Scheich

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here. All logos and trade names are the property of their respective owners.