Intersect object at a coordinate

[maksolino]

Many times i need to intersect object at one coordinate

I must create a plane and then find the intersection.

It is possible that script do this for me?

Example

1. insert the numerical value of the coordinate
   
2. select one or more object
   
3. Enter
   

Thanks

[maksolino]

Hello

I made this rvb to help myself

It is primitive but it works

This is for Z coordinate, but i have also similar for X end for Y wourld coordinates.

Can somebody make a new one whith the option to choose first the axis: X, Y or Z

Thanks

 

Option Explicit

Dim object

object = Rhino.GetObjects("Select object To intersect")

'create group

Rhino.AddGroup("Sergio")

Dim grpObjs:grpObjs=Rhino.AddObjectsToGroup(object,"Sergio")

Call CutZ()

Sub CutZ()

Dim x, y, x1, y1

Dim z

z = Rhino.GetReal("Z coordinate", 0.0)

x = -100000

y = -20000

x1 =100000

y1 =20000

Dim arrPoints(3)

arrPoints(0) = Array(x,y,z)

arrPoints(1) = Array(x1,y,z)

arrPoints(2) = Array(x1,y1,z)

arrPoints(3) = Array(x,y1,z)

If IsArray(arrPoints) Then

Rhino.Command "-layer new ZZZ enter"

Rhino.Command "-layer current ZZZ enter"

Rhino.AddSrfPt arrPoints

End If

Rhino.Command "-layer new INTS enter"

Rhino.Command "-layer current INTS enter"

Rhino.Command "_intersect -SelGroup Sergio -sellayer ZZZ enter"

Rhino.Command "-selnone -sellayer ZZZ cut enter"

Rhino.Command "-layer delete ZZZ enter"

Rhino.Command "-SelGroup Sergio -Ungroup -selnone"

End Sub

[SEANT]

Nicely done.

This has undergone limited testing but I think is heading in the direction you specified.

 

Option Explicit
Controller ' initiate controller
Sub Controller
 Dim strObjects, strObject
 Dim strOrdinateOption
 Dim strPlane
 Dim dblCoord
 Dim arrIntersect
 Dim i, TotalIntersections

 strObjects = Rhino.GetObjects("Select object To intersect", 60)
 If IsNull(strObjects) Then Exit Sub
 strOrdinateOption =UCase(Rhino.GetString("Enter X, Y, or Z to specify intersection orientation"))
 If strOrdinateOption <> "X" And strOrdinateOption <> "Y" And strOrdinateOption <> "Z" Then Exit Sub 
 Rhino.EnableRedraw (False)
 Rhino.AddLayer("INTS")
 TotalIntersections = 0
 dblCoord = Rhino.GetReal(strOrdinateOption & " coordinate", 0.0)
 If IsNull (dblCoord) Then dblCoord = 0.0
 strPlane = GeneratePlane(strOrdinateOption, dblCoord)
 Rhino.UnselectObjects strObjects

 For Each strObject In strObjects
   TotalIntersections = GetIntersect (strObject, strPlane, "INTS") + TotalIntersections  
 Next
 Rhino.DeleteObject strPlane
 Rhino.EnableRedraw (True)
 Rhino.Print "Total Intersections found - " & TotalIntersections 
End Sub

Function GeneratePlane(strOrdinateOption, dblCoord)
 Dim strPlane 
 Dim u
 Dim arrPoints(3)
 u = 100000
 If strOrdinateOption = "X" Then
   arrPoints(0) = Array(dblCoord,u,u)
   arrPoints(1) = Array(dblCoord,-u,u)
   arrPoints(2) = Array(dblCoord,-u,-u)
   arrPoints(3) = Array(dblCoord,u,-u)  

 End If 

 If strOrdinateOption = "Y" Then
   arrPoints(0) = Array(u,dblCoord,u)
   arrPoints(1) = Array(-u,dblCoord,u)
   arrPoints(2) = Array(-u,dblCoord,-u)
   arrPoints(3) = Array(u,dblCoord,-u)  

 End If 

 If strOrdinateOption = "Z" Then
   arrPoints(0) = Array(u,u,dblCoord)
   arrPoints(1) = Array(-u,u,dblCoord)
   arrPoints(2) = Array(-u,-u,dblCoord)
   arrPoints(3) = Array(u,-u,dblCoord)  

 End If
 GeneratePlane = Rhino.AddSrfPt(arrPoints)

End Function

Function GetIntersect(strObject, strPlane, strLayer)
 Dim arrObjects, i
 i = 0
 Rhino.SelectObject (strObject)
 Rhino.SelectObject (strPlane)
 Rhino.Command "_intersect", False 
 arrObjects = Rhino.LastCreatedObjects()
 If Not IsNull(arrObjects) Then
   i = UBound(arrObjects) + 1 
   Rhino.ObjectLayer arrObjects, strLayer
 End If  
 GetIntersect = i
End Function

[maksolino]

Thanks Seant

i see in the form that You are in the right direction

 

but when i Run it i get

Microsoft VBScript / Compilation error / Syntax error / Line 11, Char 32 (char &)

 

p.s. I'm using Rhino 3

[SEANT]

I can only test on Rhino 4, but I do see where the CODE tags have changed the quotation marks in my routine above. See if the attached txt file will perform better.

CoordIntersect.txt

[maksolino]

Thanks a lot

Now it works

But we have a small problem

when I select for ex. 4 items the result is

four intersection on the first selected

three intersections on the second

two on the third

and one on the last selected

Best regards

[SEANT]

Oops. I forgot objects created during the intersection operation are preselected. Add one line to this function:

 

Function GetIntersect(strObject, strPlane, strLayer)
 Dim arrObjects, i
 i = 0
 Rhino.SelectObject (strObject)
 Rhino.SelectObject (strPlane)
 Rhino.Command "_intersect", False 
 arrObjects = Rhino.LastCreatedObjects()
 If Not IsNull(arrObjects) Then
   i = UBound(arrObjects) + 1 
   Rhino.ObjectLayer arrObjects, strLayer
 End If
 Rhino.UnselectAllObjects '*****Line added to code*******
 GetIntersect = i
End Function

[maksolino]

Thanks

My wish has come true