LineSegment.IntersectWithSurface method failing - showing 'fake' intersection
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi
I'm trying to find the intersection of a line with a cylinder, but it is giving me fake results. Included is a screenshot of the line and surface I am using. Somehow the method intersectwithsurface is returning 1 intersection here.
I've just created an assembly with 2 parts, both having 1 work point. Between these points I create 1 line. I've added the transientobjects to see the linesegment and the cylinder.
How come this returns an intersection, when it does not? Also the intersection point is not even remotely close to the cylinder..?
Code for testing:
Sub TestRopes() Dim asm As AssemblyDocument Set asm = ThisApplication.ActiveDocument Dim occ1 As ComponentOccurrence, occ2 As ComponentOccurrence Set occ1 = asm.ComponentDefinition.Occurrences.Item(2) Set occ2 = asm.ComponentDefinition.Occurrences.Item(3) Dim wp1 As WorkPoint, wp2 As WorkPoint Dim wpp1 As WorkPoint, wpp2 As WorkPoint Set wp1 = occ1.Definition.WorkPoints.Item(2) Set wp2 = occ2.Definition.WorkPoints.Item(2) Call occ1.CreateGeometryProxy(wp1, wpp1) Call occ2.CreateGeometryProxy(wp2, wpp2) Call DisplayLine(wpp1.Point, wpp2.Point) End Sub
Public Sub DisplayLine(MinPoint As Point, maxpoint As Point) ' Set the active document Dim oDoc As Document Set oDoc = ThisApplication.ActiveDocument ' Set a reference to component definition of the active document. ' This assumes that a part or assembly document is active. Dim oCompDef As ComponentDefinition Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition ' Check to see if the test graphics data object already exists. ' If it does clean up by removing all associated of the client graphics ' from the document. If it doesn't create it. On Error Resume Next Dim oGraphicsData As GraphicsDataSets Set oGraphicsData = oDoc.GraphicsDataSetsCollection.Item("SampleGraphicsID") If Err.Number = 0 Then On Error GoTo 0 ' An existing client graphics object was successfully obtained so clean up. oGraphicsData.Delete oCompDef.ClientGraphicsCollection.Item("SampleGraphicsID").Delete ' update the display to see the results. ThisApplication.ActiveView.Update Call DisplayLine(MinPoint, maxpoint) Else Err.Clear On Error GoTo 0 ' Set a reference to the transient geometry object for user later. Dim oTransGeom As TransientGeometry Set oTransGeom = ThisApplication.TransientGeometry ' Create a graphics data set object. This object contains all of the ' information used to define the graphics. Dim oDataSets As GraphicsDataSets Set oDataSets = oDoc.GraphicsDataSetsCollection.Add("SampleGraphicsID") ' Create a coordinate set. Dim oCoordSet As GraphicsCoordinateSet Set oCoordSet = oDataSets.CreateCoordinateSet(1) ' Create an array that contains coordinates that define a set ' of outwardly spiraling points. Dim oPointCoords(1 To 6) As Double oPointCoords(1) = MinPoint.X oPointCoords(2) = MinPoint.y oPointCoords(3) = MinPoint.z oPointCoords(4) = maxpoint.X oPointCoords(5) = maxpoint.y oPointCoords(6) = maxpoint.z ' Assign the points into the coordinate set. Call oCoordSet.PutCoordinates(oPointCoords) ' Create the ClientGraphics object. Dim oClientGraphics As ClientGraphics Set oClientGraphics = oCompDef.ClientGraphicsCollection.Add("SampleGraphicsID") ' Create a new graphics node within the client graphics objects. Dim oLineNode As GraphicsNode Set oLineNode = oClientGraphics.AddNode(1) ' Create a LineGraphics object within the node. Dim oLineSet As LineGraphics Set oLineSet = oLineNode.AddLineGraphics ' Assign the coordinate set to the line graphics. oLineSet.CoordinateSet = oCoordSet ' Assign a color to the node using an existing appearance asset. Dim oAppearance As Asset Set oAppearance = oDoc.AppearanceAssets(1) oLineNode.Appearance = oAppearance Dim oColorSet As GraphicsColorSet Set oColorSet = oDataSets.CreateColorSet(1) ' Add a single color to the set that is red. Call oColorSet.Add(1, 255, 0, 0) oLineSet.ColorSet = oColorSet ' Create a new graphics node within the client graphics objects Dim oSurfacesNode As GraphicsNode Set oSurfacesNode = oClientGraphics.AddNode(1) Dim oTransientBRep As TransientBRep Set oTransientBRep = ThisApplication.TransientBRep ' Create a point representing the center of the bottom of ' the cone Dim oBottom As Point Set oBottom = _ ThisApplication.TransientGeometry.CreatePoint(0, -1050, 330) ' Create a point representing the tip of the cone Dim oTop As Point Set oTop = _ ThisApplication.TransientGeometry.CreatePoint(13000, -1050, 330) ' Create a transient cylinder body Dim oCylBody As SurfaceBody Set oCylBody = oTransientBRep.CreateSolidCylinderCone( _ oBottom, oTop, 330, 330, 330) ' Create client graphics based on the transient body Dim oSurfaceGraphics As SurfaceGraphics Set oSurfaceGraphics = oSurfacesNode.AddSurfaceGraphics(oCylBody) ' Update the view to see the resulting line. ThisApplication.ActiveView.Update ' Create reference to transient geo Dim oTG As TransientGeometry Set oTG = ThisApplication.TransientGeometry ' Create a linesegment Dim l As LineSegment Set l = oTG.CreateLineSegment(MinPoint, maxpoint) ' Create a point, unitvector and then a cylinder Dim p As Point Set p = oTG.CreatePoint(0, -1050, 330) Dim uv As UnitVector Set uv = oTG.CreateUnitVector(1, 0, 0) Dim cyl As Cylinder Set cyl = oTG.createCylinder(p, uv, 330) Dim cylClashes As ObjectsEnumerator Set cylClashes = l.IntersectWithSurface(cyl) Stop End If End Sub
So a cylinder with origin (0,-1050,330) would mean its rangebox min/max is respectively (0,-1380,0) (x,-720,660), x being infinite.
How come the intersectwithsurface method returns an intersection with coordinate (1375, -840, 3667) ??
Am I doing something wrong?