Jump to content

Recommended Posts

Posted

i'm looking for a lisp routine for intersect spline at coordinate value

example

1. select the splines

2. input value of coordinate (x=200 or y=400 or z=1000)

result points in drawing

Thank you

  • Replies 25
  • Created
  • Last Reply

Top Posters In This Topic

  • SEANT

    12

  • Lee Mac

    7

  • maksolino

    6

  • David Bethel

    1

Posted

i must add that the spline is always perpendicular on

some axis (in this case its about ship frames and water lines).

Im not at home whith lisp programming but the way to do it can be

1.input value (like z=4000)

1.when select a string it takes a position of the axis

2. draw a perpendicolar line on the axis whit value -100000 +100000

2. find a intersection point between line and spline

3. delete the line

4.draw the point

Posted

Unfortunately, I don’t know lisp. I did set up a test VBA routine. It only works with one orientation, however, with a target elevation along the Z axis.

 

The routine works best from either a Front or Side view – and a point picked at the desired intersection plane.

 

*Correction: Only works with entities parallel to the Front view* not Side View

 

Limited error checking employed.:nuke:

 

Sub PointsAtElevation()
Dim dblPt(2) As Double
Dim ent As AcadEntity
Dim entMirror As AcadEntity
Dim varMin As Variant
Dim varMax As Variant
Dim dblThird(2) As Double
Dim dblElevation As Double
Dim varElevPt As Variant
Dim varReturn As Variant
Dim intCount As Integer
Dim i As Integer
Dim entPt As AcadPoint
Dim objSS As AcadSelectionSet
With ThisDrawing

  On Error Resume Next
  .SelectionSets.Item("SSTemp").Delete
  On Error GoTo 0
  Set objSS = .SelectionSets.Add("SSTemp")
  objSS.SelectOnScreen
  If objSS.Count < 1 Then Exit Sub
  varElevPt = .Utility.GetPoint(, "Select target elevation: ")
  If UBound(varElevPt) <> 2 Then Exit Sub
  For Each ent In objSS
     ent.GetBoundingBox varMin, varMax
     varMin(2) = varElevPt(2)
     varMax(2) = varElevPt(2)
     dblThird(0) = varMin(0)
     dblThird(1) = varMin(1) + 1#
     dblThird(2) = varMin(2) + 1#
     Set entMirror = ent.Mirror3D(varMin, varMax, dblThird)
     varReturn = entMirror.IntersectWith(ent, acExtendNone)
     intCount = ((UBound(varReturn) + 1) / 3) - 1
     For i = 0 To intCount
        dblPt(0) = varReturn(3 * i)
        dblPt(1) = varReturn(3 * i + 1)
        dblPt(2) = varReturn(3 * i + 2)
        ThisDrawing.ModelSpace.AddPoint (dblPt)
     Next
     entMirror.Delete
  Next
End With
End Sub

Posted

I should point out that I'm assuming the Splines are all planar and in parallel planes.

Posted

I'd say that it could not be done with plain AutoLISP. I guess my question would be how to deal with multiple intersections of the spline with the given plane. I would think that a full ship frame intersects say the water line in 2 places. -David

Posted
I'd say that it could not be done with plain AutoLISP.

 

No doubt.

 

I would think that a full ship frame intersects say the water line in 2 places. -David

Perhaps even more if the design is a tunnel hull, cat- or trimaran.

Posted

Fisrt thank you for the answer but my exsperience whith vba is very poor

and i am not good enough to use the code.

Second i wont to add that always we divide the body lines of the ship

in left side, right side(almost mirror of left side),fore part and aft part.

In this case there is no multiple intersections of the spline.

Can somebody make the whole vba or lisp routine ?

Greetings

Posted

Is it possible to post a sample file with the splines set up in a typical configuration? I’m envisioning a oriented 3D layout but guess I don’t know that for certain.

 

In general, an example file is the best way to give full scope to the problem in question. The “full scope” also seems to be the best way to generate interest and enthusiasm within in the resident code writing community.

Posted

sorry that i don't do it before

naw i attach one sample file with the splines set up in a typical configuration.

I must draw a lot of waterlines and then a lot of frames

Frames is in always situated in yz plane

and waterlines in xy plane

testforma.dwg

Posted

This is probably way off, as I have only caught the end of this thread, but this should find the intersections between your spline and the Polylines.

 

(defun c:SplInt (/ spEnt ss spObj ObjLst iArr ptLst)
 (if (and (setq spEnt (car (entsel "\nSelect Spline to Retrieve Intersections...")))
      (= "SPLINE" (cdadr (entget spEnt)))
      (setq ss (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 "SHP")
           (if (getvar "CTAB")(cons 410 (getvar "CTAB"))
               (cons 67 (- 1 (getvar "TILEMODE"))))))))
   (progn
     (setq spObj (vlax-ename->vla-object spEnt)
       ObjLst (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex ss))))
     (foreach Obj ObjLst
   (setq iArr (vlax-variant-value (vla-IntersectWith spObj Obj acExtendNone)))
   (if (> (vlax-safearray-get-u-bound iArr 1) 0)
       (setq ptLst (cons (vlax-safearray->list iArr) ptLst))))
     (alert (vl-princ-to-string ptLst)))
   (princ "\n<!> No Spline Selected or No PLines Found <!>"))
 (princ))

Posted
This is probably way off, as I have only caught the end of this thread, but this should find the intersections between your spline and the Polylines.

 

It is more like the intersection of the poly’s or splines with a plane i.e., where a curve crosses Z = 15000.

 

I have to say it is not an easy task in VBA (without the Curve Functions). I could have tried it in C#, but I have no way of testing .NET code against 2006.

 

Here (and in my original post) I used a Mirror3D and then IntersectWith to get the appropriate intersections.

 

To use load and run PointsAtElevation

 

 

To run a VBA routine:

http://www.cadtutor.net/forum/showthread.php?t=30608

 

 

 

 

*Edit - Works with AutoCAD 2009 but not 2004.

 

Option Explicit

Sub PointsAtElevation()
Dim dblPt(2) As Double
Dim ent As AcadEntity
Dim entMirror As AcadEntity
Dim varMin As Variant
Dim varMax As Variant
Dim dblThird(2) As Double
Dim dblElevation As Double
Dim varElevPt As Variant
Dim varReturn As Variant
Dim intCount As Integer
Dim i As Integer
Dim entPt As AcadPoint
Dim objSS As AcadSelectionSet
Dim strKeyWordList As String
Dim intAxis As Integer
Dim strTemp As String
Dim dblElev As Double
Dim varFilter As Variant
Dim strKeyWord As String
Dim blnErase As Boolean

With ThisDrawing
  strKeyWordList = "X x Y y Z z"
  .Utility.InitializeUserInput 1, strKeyWordList
  On Error Resume Next
  strKeyWord = .Utility.GetKeyword("Enter axis of interest [X, Y, Z]: ")
  If Err Then Exit Sub
  If UCase(strKeyWord) = "X" Then
     intAxis = 0
  ElseIf UCase(strKeyWord) = "Y" Then
     intAxis = 1
  ElseIf UCase(strKeyWord) = "Z" Then
     intAxis = 2
  Else
     .Utility.Prompt (vbCr & "Invalid input!")
     Exit Sub
  End If
  
  strKeyWordList = "*"
  .Utility.InitializeUserInput 128, strKeyWordList
  varElevPt = .Utility.GetPoint(, "Select target elevation, or input elevation value: ")
  strTemp = .Utility.GetInput()
  
  If UBound(varElevPt) <> 2 Then
     Err.Clear
     dblElev = CDbl(strTemp)
     If Err Then Exit Sub
  Else
     dblElev = varElevPt(intAxis)
  End If
  On Error GoTo 0
  varFilter = LoadFilterArray(intAxis)
  If SoSSS(varFilter(0), varFilter(1)) > 0 Then
     For Each ent In .SelectionSets("TempSSet")
        If TypeOf ent Is AcadLWPolyline Then
           Set ent = ProcessPoly(ent)
           blnErase = True
        End If
        
        ent.GetBoundingBox varMin, varMax
        varMin(intAxis) = dblElev
        varMax(intAxis) = dblElev
        dblThird(0) = varMin(0) + 1#
        dblThird(1) = varMin(1) + 1#
        dblThird(2) = varMin(2) + 1#
        Set entMirror = ent.Mirror3D(varMin, varMax, dblThird)
        varReturn = entMirror.IntersectWith(ent, acExtendNone)
        intCount = ((UBound(varReturn) + 1) / 3) - 1
        For i = 0 To intCount
           dblPt(0) = varReturn(3 * i)
           dblPt(1) = varReturn(3 * i + 1)
           dblPt(2) = varReturn(3 * i + 2)
           ThisDrawing.ModelSpace.AddPoint (dblPt)
        Next
        If blnErase Then ent.Delete: blnErase = False
        entMirror.Delete
     Next
  End If
End With
End Sub

Private Sub SSClear()
Dim SSS As AcadSelectionSets
  Set SSS = ThisDrawing.SelectionSets
  If SSS.Count > 0 Then
     Dim objSS As AcadSelectionSet
     For Each objSS In SSS
        If objSS.Name = "TempSSet" Then objSS.Delete: Exit Sub
     Next
  Else
     Exit Sub
  End If
End Sub

Function SoSSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer
  Dim TempObjSS As AcadSelectionSet
  SSClear
  Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet")
        'pick selection set
  If IsMissing(grpCode) Then
     TempObjSS.SelectOnScreen
  Else
     TempObjSS.SelectOnScreen grpCode, dataVal
  End If
  SoSSS = TempObjSS.Count
End Function

Function LoadFilterArray(intAxis As Integer) As Variant
Dim intCode(21) As Integer
Dim varData(21) As Variant
Dim varArray(1) As Variant
Dim dblAxis1(2) As Double
Dim dblAxis2(2) As Double
Dim dblAxis3(2) As Double
Dim dblAxis4(2) As Double
  
  dblAxis1((intAxis + 1) Mod 3) = 1#
  dblAxis2((intAxis + 2) Mod 3) = 1#
  dblAxis3((intAxis + 1) Mod 3) = -1#
  dblAxis4((intAxis + 2) Mod 3) = -1#
  
intCode(0) = -4: varData(0) = "<Or"

  intCode(1) = -4: varData(1) = "<And"
     intCode(2) = 0: varData(2) = "Spline" 'planar Splines
     intCode(3) = -4: varData(3) = "&="
     intCode(4) = 70: varData(4) = 8
     intCode(5) = -4: varData(5) = "<Or"
        intCode(6) = 210: varData(6) = dblAxis1
        intCode(7) = 210: varData(7) = dblAxis2
        intCode( = 210: varData( = dblAxis3
        intCode(9) = 210: varData(9) = dblAxis4
     intCode(10) = -4: varData(10) = "Or>"
  intCode(11) = -4: varData(11) = "And>"
  
  intCode(12) = -4: varData(12) = "<And"
     intCode(13) = 0: varData(13) = "LWPOLYLINE" 'or LWP's
     intCode(14) = -4: varData(14) = "<Or"
        intCode(15) = 210: varData(15) = dblAxis1
        intCode(16) = 210: varData(16) = dblAxis2
        intCode(17) = 210: varData(17) = dblAxis3
        intCode(18) = 210: varData(18) = dblAxis4
     intCode(19) = -4: varData(19) = "Or>"
  intCode(20) = -4: varData(20) = "And>"

intCode(21) = -4: varData(21) = "Or>"
  
  varArray(0) = intCode
  varArray(1) = varData
  LoadFilterArray = varArray
End Function

Function ProcessPoly(ent As AcadLWPolyline) As Acad3DPolyline

Dim dblNormal() As Double
Dim varPLCoord As Variant
Dim dblCoords() As Double
Dim intUbound As Integer
Dim i As Integer
Dim varDummy As Variant
Dim dblElev As Double
Dim dblTransfer(2) As Double


dblNormal = ent.Normal
dblElev = ent.Elevation
intUbound = ((UBound(ent.Coordinates) + 1) / 2) - 1
ReDim dblCoords((((intUbound + 1) * 3) - 1))
For i = 0 To intUbound
  varPLCoord = ent.Coordinate(i)
  dblTransfer(0) = varPLCoord(0)
  dblTransfer(1) = varPLCoord(1)
  dblTransfer(2) = dblElev
  varPLCoord = ThisDrawing.Utility.TranslateCoordinates(dblTransfer, acOCS, acWorld, 0, dblNormal)
  dblCoords(i * 3) = varPLCoord(0)
  dblCoords(i * 3 + 1) = varPLCoord(1)
  dblCoords(i * 3 + 2) = varPLCoord(2)
Next

Set ProcessPoly = ThisDrawing.ModelSpace.Add3DPoly(dblCoords)
End Function

Posted

Here's a 2004 compatible version.

 

 

Apparently VBA support for Normals of Planar Splines was not available back in 2004. This routine (AC2004Compatible.txt) employs a different approach.

 

One additional note, both this and the routine posted previously handle only LightWeightPolys and/or Planar Splines.

 

 

Edit: See updated code http://www.cadtutor.net/forum/showpost.php?p=222822&postcount=22

Posted

Ahh, maybe the code I posted was not the best suited then :oops:

 

 

I had a look at using the curve functions in VL, but couldn't think how to get a point on the curve at some user defined elevation without using some iterative process by which one would move along the curve at small intervals until you get close enough by some tolerance to the required elevation :(

 

I didn't like this method and so didn't pursue it.

Posted

You mention that you used "mirror3d" followed by "intersectWith", just curious (and I am not too conversant with VBA), how did the "mirror3d" come into it :huh:

 

Thanks

 

Lee

Posted

The OP stated that all the Curves in question would be planar and aligned to one of the three main orthographic planes. Because of that a Bounding Box call will return essentially a planar expanse and, if the target elevation is substituted for the appropriate coordinate of min and max, it would create a nice line across the curve.

 

My original notion was to use that line to IntersectWith the curve. For some reason (which I have yet to figure out) that was not giving me any intersections. For the hell of it, I tried to use identical entities, and figured one was readily available if I 3Dmirrored the original curve about that elevation line and calc’ed point (see Sample).

 

Those intersect well enough. :roll:

MirrorIntersect.dwg

Posted

Ahh, I see - so how I understand it is that "intersectwith" seems to only work in the x-y plane.

 

Thats funny, because, if you try my posted LISP to find the intersections between the splines and the polylines in the OP's posted drawing, it returns nil until you try it on a spline and pline in the x-y plane.

 

Lee

 

PS> Great example drawing - well drafted.

Posted

IntersectWith does seem a bit spotty. The same mirror method does not work with Lightweight polylines. *

 

I guess with polylines, in particular, their planar quality is virtually a core component of their entity type. It sort of makes sense that their implementation of IntersectWith is extremely sensitive to common planes. Have you tried IntersectWith between a poly and spline on a common plane other than WCS’s XY? It may work if they were both on the XZ, for instance.

 

Splines are not required to be planar, thus may have gotten a little more attention from the boys at Autodesk with regard to intersections between planes.

 

* I had to provide a conversion to splines to get my routine to work with LWPolys. In fact, if the polys are too coarse, there may be significant error to the calculated elevation points.

Posted

Ahh good thinking Sean, they may have only accommodated intersecting Plines within the same plane.

 

Tbh, I haven't spent much time on the IntersectWith method ~ I wrote a couple of LISPs a while back though, just messing around with it, could be worth some experimentation with them to see where we stand :)

 

(defun ssInter (ss / i y Ent1 Ent2 iArr iLst)
 (setq i (sslength ss))
 (while (not (minusp (setq y (1- i) i (1- i))))
   (setq Ent1 (vlax-ename->vla-object (ssname ss i)))
   (while (not (minusp (setq y (1- y))))
     (setq Ent2 (vlax-ename->vla-object (ssname ss y))
       iArr (vlax-variant-value
         (vla-IntersectWith Ent1 Ent2 acExtendNone)))
     (if (> (vlax-safearray-get-u-bound iArr 1) 0)
   (progn
     (setq iLst (vlax-safearray->list iArr))
     (while (not (zerop (length iLst)))
       (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst)
         iLst (cdddr iLst))))))))

(defun c:test (/ ptLst)
 (vl-load-com)
 (ssInter (ssget))
 (alert (vl-princ-to-string ptLst))
 (princ))

 

(defun ssInter (ss / vLst i j obj1 obj2 iArr iLst)
 (setq vLst (mapcar 'vlax-ename->vla-object
            (vl-remove-if 'listp
              (mapcar 'cadr (ssnamex ss))))
   i (length vLst))
 (while (not (minusp (setq j (1- i) i (1- i))))
   (setq obj1 (nth i vLst))
   (while (not (minusp (setq j (1- j))))
     (setq obj2 (nth j vLst)
       iArr (vlax-variant-value
         (vla-IntersectWith obj1 obj2 acExtendNone)))      
     (if (> (vlax-safearray-get-u-bound iArr 1) 0)
   (progn
     (setq iLst (vlax-safearray->list iArr))
     (while (not (zerop (length iLst)))
       (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst)
         iLst (cdddr iLst))))))))


(defun c:test (/ ptLst)
 (vl-load-com)
 (ssInter (ssget))
 (alert (vl-princ-to-string ptLst))
 (princ))

 

They both do pretty much the same thing - find all intersections in a selection set. But the second approach the selection set as a list of entities, whereas the first just hits the set head on.

 

I was just experimenting with different ways to accomplish the same goal - could be useful though, for testing with IntersectWith.

 

Cheers

 

Lee

Posted

Nice. Those will help determine where and when intersections can be acquired.

 

Now that we’ve talked about it, I wonder if 3DPoly’s are more or less capable of finding Intersections. Next time I’m in front of AutoCAD, I’ll use your routine to test them. That alternative may help me reduce the Spline induced error I mentioned previously.

Posted
Nice. Those will help determine where and when intersections can be acquired.

 

Now that we’ve talked about it, I wonder if 3DPoly’s are more or less capable of finding Intersections. Next time I’m in front of AutoCAD, I’ll use your routine to test them. That alternative may help me reduce the Spline induced error I mentioned previously.

 

I feel honoured :P

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...