Topic: Extracting segment information from LWPoly

[b.benn]

This is not how I would prefer to post my first message, but I have a problem…

I am trying to come up with a lisp function that takes two arguments:  an LWPolyline and a point on that object.  The return value should be the DXF code for the line or arc segment that contains the point.

For example, given an LWPolyline with vertices (0, 0), (1, 0), (1, 1), and (0, 1) and a point of (1, 0.5), the function should return:  ((10 1.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 1.0 1.0)).

I have a lengthy (and messy) solution that involves exploding the polyline, then using Nentselp to select the segment, and finally extracting the points and bulge information.  However, this only works if the polyline has a constant width (since individual line widths are lost when exploded.)

One additional quirk:  this needs to work in AutoCAD 14.

Any ideas?

[Jeff_M]

One additional quirk:  this needs to work in AutoCAD 14.

I was with you and had it partially coded in my head until I got to this part..... 
I no longer have R14 around here, were the (vlax-curve-*) functions available in that version?

[b.benn]

I was with you and had it partially coded in my head until I got to this part..... 
I no longer have R14 around here, were the (vlax-curve-*) functions available in that version?

I don't think so.  The R14 is the kicker.

[T.Willey]

I have an idea, give me a minute and I will post what I think will work.

[T.Willey]

Here you go.  It's pretty ugly (just modified a code I just did).  It works on my testing.

Code: [Select]

(defun c:Test (/ Sel Pt Pobj EntData Ptype PtList VertexPt PtListIndex StWd EndWd PolyList OldIndex StPos cnt
                        tmpList ShouldClose)

(defun ChangeOldStyle (Ent / Pent cnt EntData PolyInfoList StPos StPt ShouldClose)

(setq Pent Ent)
(setq cnt 0)
(while
 (and
  (setq Ent (entnext Ent))
  (setq EntData (entget Ent))
  (= (cdr (assoc 0 EntData)) "VERTEX")
 )
 (setq PolyInfoList
  (append
   PolyInfoList
   (list (assoc 10 EntData))
   (list (assoc 40 EntData))
   (list (assoc 41 EntData))
   (list (assoc 42 EntData))
  )
 )
 (if (equal cnt 0)
  (setq StPt (cdr (assoc 10 EntData)))
 )
 (setq cnt (1+ cnt))
)
PolyInfoList
)
;-----------------------------------------------------------
(if
 (and
  (setq Sel (entsel "\n Select polyline: "))
  (setq Pt (getpoint "\n Select point on polyline: "))
  (setq EntData (entget (car Sel)))
  (wcmatch (setq Ptype (cdr (assoc 0 EntData))) "*POLYLINE")
  (setq cnt 0)
 )
 (progn
  (if (= Ptype "POLYLINE")
   (setq PtList (ChangeOldStyle (car Sel)))
   (progn
    (setq PtList
     (vl-remove-if-not
      '(lambda (x)
       (vl-position (car x) '(10 42 40 41))
      )
      EntData
     )
    )
   )
  )
  (if PtList
   (while
    (and
     (< cnt (length PtList))
     (not
      (vl-catch-all-error-p
       (vl-catch-all-apply
        '(lambda ()
         (if
          (and
           (< cnt (length PtList))
           (setq StPt (cdr (nth cnt PtList)))
           (setq EndPt (cdr (nth (+ 4 cnt) PtList)))
           (or
            (equal (angle StPt EndPt) (angle StPt Pt) 0.0001)
            (equal (angle EndPt StPt) (angle StPt Pt) 0.0001)
           )
           (equal (distance StPt EndPt) (+ (distance StPt Pt) (distance Pt EndPt)) 0.0001)
          )
          (progn
           (setq tmpList (list StPt (nth (1+ cnt) PtList) (nth (+ 2 cnt) PtList) (nth (+ 3 cnt) PtList) EndPt))
           (exit)
          )
         )
        )
       )
      )
     )
     (setq cnt (+ 4 cnt))
    )
   )
  )
 )
)
tmpList
)
Returns

Command: test
 Select polyline:
 Select point on polyline: ((21.6633 20.2063) (40 . 0.0) (41 . 0.0) (42 . 0.0) (28.1353 9.12882))

[b.benn]

Thanks for the reply, Tim.  I am running into two issues with the program:

1)  The program does not run correctly in AutoCAD 14.  I am getting a null function error due to the VL- functions.

2)  The program does not appear to address the situation where the given point lands on an arc within the polyline.

I am going to take a look and see if I can adjust your original program.

[T.Willey]

1)  The program does not run correctly in AutoCAD 14.  I am getting a null function error due to the VL- functions.

This should solve that, sorry about that.  Forgot you can use those.

Code: [Select]

(defun c:Test (/ Sel Pt Pobj EntData Ptype PtList VertexPt PtListIndex StWd EndWd PolyList OldIndex StPos cnt
                        tmpList ShouldClose)

(defun ChangeOldStyle (Ent / Pent cnt EntData PolyInfoList StPos StPt ShouldClose)

(setq Pent Ent)
(setq cnt 0)
(while
 (and
  (setq Ent (entnext Ent))
  (setq EntData (entget Ent))
  (= (cdr (assoc 0 EntData)) "VERTEX")
 )
 (setq PolyInfoList
  (append
   PolyInfoList
   (list (assoc 10 EntData))
   (list (assoc 40 EntData))
   (list (assoc 41 EntData))
   (list (assoc 42 EntData))
  )
 )
 (if (equal cnt 0)
  (setq StPt (cdr (assoc 10 EntData)))
 )
 (setq cnt (1+ cnt))
)
PolyInfoList
)
;-----------------------------------------------------------
(if
 (and
  (setq Sel (entsel "\n Select polyline: "))
  (setq Pt (getpoint "\n Select point on polyline: "))
  (setq EntData (entget (car Sel)))
  (wcmatch (setq Ptype (cdr (assoc 0 EntData))) "*POLYLINE")
  (setq cnt -4)
 )
 (progn
  (if (= Ptype "POLYLINE")
   (setq PtList (ChangeOldStyle (car Sel)))
   (progn
    (setq PtList
     (vl-remove-if-not
      '(lambda (x)
       (vl-position (car x) '(10 42 40 41))
      )
      EntData
     )
    )
   )
  )
  (if PtList
   (while
    (and
     (< cnt (length PtList))
     (setq cnt (+ 4 cnt))
     (not tmpList)
    )
    (if
     (and
      (< cnt (length PtList))
      (setq StPt (cdr (nth cnt PtList)))
      (setq EndPt (cdr (nth (+ 4 cnt) PtList)))
      (or
       (equal (angle StPt EndPt) (angle StPt Pt) 0.0001)
       (equal (angle EndPt StPt) (angle StPt Pt) 0.0001)
      )
      (equal (distance StPt EndPt) (+ (distance StPt Pt) (distance Pt EndPt)) 0.0001)
     )
     (setq tmpList (list StPt (nth (1+ cnt) PtList) (nth (+ 2 cnt) PtList) (nth (+ 3 cnt) PtList) EndPt))
    )
   )
  )
 )
)
tmpList
)


2)  The program does not appear to address the situation where the given point lands on an arc within the polyline.

This one I'm not so sure about.  I see if I can come up with one.

[Jeff_M]

Ahem....

Code: [Select]

.....
    (setq PtList
     (vl-remove-if-not
      '(lambda (x)
       (vl-position (car x) '(10 42 40 41))
      )
      EntData
     )
    )
   )
  )
.....


I still see some (vl-*) stuff in there

[T.Willey]

Dang it.   

Here you go.  What a test this is.

Code: [Select]

(defun c:Test (/ Sel Pt Pobj EntData Ptype PtList VertexPt PtListIndex StWd EndWd PolyList OldIndex StPos cnt
                        tmpList ShouldClose)

(defun ChangeOldStyle (Ent / Pent cnt EntData PolyInfoList StPos StPt ShouldClose)

(setq Pent Ent)
(setq cnt 0)
(while
 (and
  (setq Ent (entnext Ent))
  (setq EntData (entget Ent))
  (= (cdr (assoc 0 EntData)) "VERTEX")
 )
 (setq PolyInfoList
  (append
   PolyInfoList
   (list (assoc 10 EntData))
   (list (assoc 40 EntData))
   (list (assoc 41 EntData))
   (list (assoc 42 EntData))
  )
 )
 (if (equal cnt 0)
  (setq StPt (cdr (assoc 10 EntData)))
 )
 (setq cnt (1+ cnt))
)
PolyInfoList
)
;-----------------------------------------------------------
(if
 (and
  (setq Sel (entsel "\n Select polyline: "))
  (setq Pt (getpoint "\n Select point on polyline: "))
  (setq EntData (entget (car Sel)))
  (wcmatch (setq Ptype (cdr (assoc 0 EntData))) "*POLYLINE")
  (setq cnt -4)
 )
 (progn
  (if (= Ptype "POLYLINE")
   (setq PtList (ChangeOldStyle (car Sel)))
   (foreach pair EntData
    (if (vl-position (car pair) '(10 42 40 41))
     (setq PtList (append PtList (list pair)))
    )
   )
  )
  (if PtList
   (while
    (and
     (< cnt (length PtList))
     (setq cnt (+ 4 cnt))
     (not tmpList)
    )
    (if
     (and
      (< cnt (length PtList))
      (setq StPt (cdr (nth cnt PtList)))
      (setq EndPt (cdr (nth (+ 4 cnt) PtList)))
      (or
       (equal (angle StPt EndPt) (angle StPt Pt) 0.0001)
       (equal (angle EndPt StPt) (angle StPt Pt) 0.0001)
      )
      (equal (distance StPt EndPt) (+ (distance StPt Pt) (distance Pt EndPt)) 0.0001)
     )
     (setq tmpList (list StPt (nth (1+ cnt) PtList) (nth (+ 2 cnt) PtList) (nth (+ 3 cnt) PtList) EndPt))
    )
   )
  )
 )
)
tmpList
)


[Jeff_M]

Well, I took Tim's code (the second one posted) and modified it (I hope you don't mind Tim). This version works with arcs, I'm not sure if Tim's latest one takes those into account. I used a function by Jurg Menzi that he had posted a number of years ago to get the bulge data of an arc segment.

Code: [Select]

(defun c:Test (/ Sel Pt Pobj EntData Ptype PtList VertexPt PtListIndex StWd EndWd PolyList OldIndex StPos cnt
                        tmpList ShouldClose)

(defun ChangeOldStyle (Ent / Pent cnt EntData PolyInfoList StPos StPt ShouldClose)

(setq Pent Ent)
(setq cnt 0)
(while
 (and
  (setq Ent (entnext Ent))
  (setq EntData (entget Ent))
  (= (cdr (assoc 0 EntData)) "VERTEX")
 )
 (setq PolyInfoList
  (append
   PolyInfoList
   (list (assoc 10 EntData))
   (list (assoc 40 EntData))
   (list (assoc 41 EntData))
   (list (assoc 42 EntData))
  )
 )
 (if (equal cnt 0)
  (setq StPt (cdr (assoc 10 EntData)))
 )
 (setq cnt (1+ cnt))
)
PolyInfoList
)
;-----------------------------------------------------------
  ; -- Function CalcBulge
; Returns the geometric informations from a polyarc.
; Copyright:
;   ©2001 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Typ]:
;   Vx1 = Start vertex of p'arc [LIST]
;   Vx2 = End vertex of p'arc [LIST]
;   Blg = Bulge [REAL]
; Return [Typ]:
;   > '(CenterPoint Radius IncludedAngle) [LIST]
; Notes:
;   IncludedAngle in radians
;
(defun CalcBulge (Vx1 Vx2 Blg / ArcRad CenDir HlfAng)
 (setq HlfAng (* 2 (atan Blg))
       CenDir ((if (< Blg 0) - +) (- (angle Vx1 Vx2) HlfAng) (/ pi 2))
       ArcRad (abs (/ (/ (distance Vx1 Vx2) 2.0) (sin HlfAng)))
 )
 (list
  (polar Vx1 CenDir ArcRad)
  ArcRad
  (* (abs HlfAng) 2.0)
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if
 (and
  (setq Sel (entsel "\n Select polyline: "))
  (setq Pt (getpoint "\n Select point on polyline: "))
  (setq EntData (entget (car Sel)))
  (wcmatch (setq Ptype (cdr (assoc 0 EntData))) "*POLYLINE")
  (setq cnt -4)
 )
 (progn
  (if (= Ptype "POLYLINE")
   (setq PtList (ChangeOldStyle (car Sel)))
   (progn
;;;    (setq PtList
;;;     (vl-remove-if-not
;;;      '(lambda (x)
;;;       (vl-position (car x) '(10 42 40 41))
;;;      )
;;;      EntData
;;;     )
;;;    )
     (foreach x EntData
       (if (member (car x) '(10 42 40 41))
(setq PtList (cons x PtList))
)
       )
     (setq ptList (reverse PtList))
   )
  )
  (if PtList
   (while
    (and
     (< cnt (length PtList))
     (setq cnt (+ 4 cnt))
     (not tmpList)
    )
    (if
     (and
      (< cnt (length PtList))
      (setq StPt (cdr (nth cnt PtList)))
      (setq EndPt (cdr (nth (+ 4 cnt) PtList)))
      (setq bulge (cdr (nth (+ 3 cnt) PtList)))
      (if (equal bulge 0.0 0.00001)
(and
  (or
    (equal (angle StPt EndPt) (angle StPt Pt) 0.0001)
    (equal (angle EndPt StPt) (angle StPt Pt) 0.0001)
    )
  (equal (distance StPt EndPt) (+ (distance StPt Pt) (distance Pt EndPt)) 0.0001)
  )
(and
  (setq arcdata (calcbulge stpt endpt bulge))
  (equal (distance pt (car arcdata)) (cadr arcdata) 0.0001)
  )
)
     )
     (setq tmpList (list StPt (nth (1+ cnt) PtList) (nth (+ 2 cnt) PtList) (nth (+ 3 cnt) PtList) EndPt))
    )
   )
  )
 )
)
tmpList
)


[T.Willey]

Well, I took Tim's code (the second one posted) and modified it (I hope you don't mind Tim). This version works with arcs, I'm not sure if Tim's latest one takes those into account. I used a function by Jurg Menzi that he had posted a number of years ago to get the bulge data of an arc segment.

Not at all Jeff.  If you can figure out the arc portion, all the more power to ya.  I see you handle the other 'vl' function the same way (almost) as I did.

[Jeff_M]

I see you handle the other 'vl' function the same way (almost) as I did.

Yeah, I took out ALL of the (vl-*) calls (You left a (vl-position) in there.....)

I tested my version on a couple of arced plines and got the results I expected. But without R14 here to test with I can only cross my fingers that all plines will list correctly.

[T.Willey]

I see you handle the other 'vl' function the same way (almost) as I did.

Yeah, I took out ALL of the (vl-*) calls (You left a (vl-position) in there.....)

Man, I quit.  :pissed: 

I tested my version on a couple of arced plines and got the results I expected. But without R14 here to test with I can only cross my fingers that all plines will list correctly.

Same here.

[b.benn]

Tim and Jeff,

You guys are awesome!  I have tested the final program in R14 and can confirm that it does work.

Now I just need to sit down and figure out how it works!

Once again, thanks guys.

Bruce

[T.Willey]

You're welcome Bruce.  The portion that I did.  I take the points, starting width, ending width and the bulge.  I keep them in order, and then take the point that is picked, and test it against the points of the pline.  I test it by the angle, to make sure they are the same, and then the distance for the starting point of the segment, to the ending point of the segment, and make sure that the distance form the starting point to the point picked, and the point picked to the ending point are the same.  If you need more explaination, about the bulge, that is what Jeff did, and I would not know how to do.    Thanks Jeff for that.