Polyline Vertex Number Query

I want to know the vertex number of the Polyline of certain corner. Using the object properties and scrolling vertex it takes time.

Guys, can make us a lisp.. by clicking the corner of polyline it will give you the vertex number of that corner.

Give this a try and let me know how it works for you...

(defun unit ( v )
 (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)

(defun mxv ( m v )
 (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun v^v ( u v )
 (mapcar '(lambda ( n ) (- (* (nth (car n) u) (nth (cadr n) v)) (* (nth (cadr n) u) (nth (car n) v)))) '((1 2) (2 0) (0 1)))
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
 (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
 (setq ux (unit (mapcar '- p2 p1)))
 (setq uy (unit (mapcar '- p3 p1)))
 
 (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
 (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
 (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
 (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
 (transptucs pt pt1n pt2n pt3n)
)

(defun hplv ( pl / el uz v vl ux uy )
 (if (and (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (< -1 (cdr (assoc 70 (entget pl))) 6))
   (progn
     (setq el (last (cdr (assoc 10 (entget pl)))))
     (setq uz (cdr (assoc 210 (entget pl))))
     (setq v pl)
     (while (eq (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX")
       (setq vl (cons (list (car (cdr (assoc 10 (entget v)))) (cadr (cdr (assoc 10 (entget v)))) el) vl))
     )
     (if (equal uz '(0.0 0.0 1.0) 1e- (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (equal uz '(0.0 0.0 -1.0) 1e- (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (not (or (equal uz '(0.0 0.0 1.0) 1e- (equal uz '(0.0 0.0 -1.0) 1e-)) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
     (if (not uy) (setq uy (unit (v^v uz ux))))
     (setq vl (mapcar '(lambda ( p ) (transptwcs p '(0.0 0.0 0.0) ux uy)) vl))
     (reverse vl)
   )
   (progn
     (prompt "\nNot valid pl agument supplied to function") 
     (princ)
   )
 )
)

(defun lplv ( pl / el uz vl ux uy )
 (if (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
   (progn
     (setq el (cdr (assoc 38 (entget pl))))
     (setq uz (cdr (assoc 210 (entget pl))))
     (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda ( p ) (= (car p) 10)) (entget pl))))
     (setq vl (mapcar '(lambda ( p ) (list (car p) (cadr p) el)) vl))
     (if (equal uz '(0.0 0.0 1.0) 1e- (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (equal uz '(0.0 0.0 -1.0) 1e- (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (not (or (equal uz '(0.0 0.0 1.0) 1e- (equal uz '(0.0 0.0 -1.0) 1e-)) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
     (if (not uy) (setq uy (unit (v^v uz ux))))
     (setq vl (mapcar '(lambda ( p ) (transptwcs p '(0.0 0.0 0.0) ux uy)) vl))
     vl
   )
   (progn
     (prompt "\nNot valid pl agument supplied to function") 
     (princ)
   )
 )
)

(defun c:plvertnumb (/ osm pt pl vl i)
 (setq osm (getvar 'osmode))
 (setvar 'osmode 1)
 (setq pt (getpoint "\nPick vertex point on pline to retrieve its position number : "))
 (setq pl (ssname (ssget "_C" pt pt) 0))
 (setq pt (trans pt 1 0))
 (if (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
   (progn
     (setq vl (lplv pl))
     (setq i (vl-position pt vl))
   )
   (progn
     (setq vl (hplv pl))
     (setq i (vl-position pt vl))
   )
 )
 (prompt "\nPicked vertex is on the ") (princ (itoa (+ i 1))) (prompt " position")
 (setvar 'osmode osm)
 (princ)
)

M.R.

ThanX! M.R. Cheers!!

If you have still time, can you make the programs run until I press "Esc".

Although I think you could easily do this, here is it...

(defun unit ( v )
 (mapcar '(lambda ( x ) (/ x (distance '(0.0 0.0 0.0) v))) v)
)

(defun mxv ( m v )
 (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(defun v^v ( u v )
 (mapcar '(lambda ( n ) (- (* (nth (car n) u) (nth (cadr n) v)) (* (nth (cadr n) u) (nth (car n) v)))) '((1 2) (2 0) (0 1)))
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
 (setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
 (setq ux (unit (mapcar '- p2 p1)))
 (setq uy (unit (mapcar '- p3 p1)))
 
 (mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
 (setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
 (setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
 (setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
 (transptucs pt pt1n pt2n pt3n)
)

(defun hplv ( pl / el uz v vl ux uy )
 (if (and (eq (cdr (assoc 0 (entget pl))) "POLYLINE") (< -1 (cdr (assoc 70 (entget pl))) 6))
   (progn
     (setq el (last (cdr (assoc 10 (entget pl)))))
     (setq uz (cdr (assoc 210 (entget pl))))
     (setq v pl)
     (while (eq (cdr (assoc 0 (entget (setq v (entnext v))))) "VERTEX")
       (setq vl (cons (list (car (cdr (assoc 10 (entget v)))) (cadr (cdr (assoc 10 (entget v)))) el) vl))
     )
     (if (equal uz '(0.0 0.0 1.0) 1e- (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (equal uz '(0.0 0.0 -1.0) 1e- (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (not (or (equal uz '(0.0 0.0 1.0) 1e- (equal uz '(0.0 0.0 -1.0) 1e-)) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
     (if (not uy) (setq uy (unit (v^v uz ux))))
     (setq vl (mapcar '(lambda ( p ) (transptwcs p '(0.0 0.0 0.0) ux uy)) vl))
     (reverse vl)
   )
   (progn
     (prompt "\nNot valid pl agument supplied to function") 
     (princ)
   )
 )
)

(defun lplv ( pl / el uz vl ux uy )
 (if (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
   (progn
     (setq el (cdr (assoc 38 (entget pl))))
     (setq uz (cdr (assoc 210 (entget pl))))
     (setq vl (mapcar 'cdr (vl-remove-if-not '(lambda ( p ) (= (car p) 10)) (entget pl))))
     (setq vl (mapcar '(lambda ( p ) (list (car p) (cadr p) el)) vl))
     (if (equal uz '(0.0 0.0 1.0) 1e- (setq ux '(1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (equal uz '(0.0 0.0 -1.0) 1e- (setq ux '(-1.0 0.0 0.0) uy '(0.0 1.0 0.0)))
     (if (not (or (equal uz '(0.0 0.0 1.0) 1e- (equal uz '(0.0 0.0 -1.0) 1e-)) (setq ux (unit (v^v '(0.0 0.0 1.0) uz))))
     (if (not uy) (setq uy (unit (v^v uz ux))))
     (setq vl (mapcar '(lambda ( p ) (transptwcs p '(0.0 0.0 0.0) ux uy)) vl))
     vl
   )
   (progn
     (prompt "\nNot valid pl agument supplied to function") 
     (princ)
   )
 )
)

(defun c:plvertnumb (/ *error* osm pt pl vl i)

 (defun *error* (msg)
   (if osm (setvar 'osmode osm))
   (if msg (prompt msg))
   (princ)
 )

 (setq osm (getvar 'osmode))
 (setvar 'osmode 1)
 (while (and
          (not (initget 128))
          (setq pt (getpoint "\nPick vertex point on pline to retrieve its position number : "))
          (listp pt)
        )
       (setq pl (ssname (ssget "_C" pt pt) 0))
       (setq pt (trans pt 1 0))
       (if (eq (cdr (assoc 0 (entget pl))) "LWPOLYLINE")
         (progn
           (setq vl (lplv pl))
           (setq i (vl-position pt vl))
         )
         (progn
           (setq vl (hplv pl))
           (setq i (vl-position pt vl))
         )
       )
       (prompt "\nPicked vertex is on the ") (princ (itoa (+ i 1))) (prompt " position")
 )
 (*error* nil)
 (princ)
)

M.R.

Thank you!!

M.R., you are kind & great!!

An alternative:

(defun c:vn ( / p s )
   (while (setq p (getpoint "\nPick vertex <Exit>: "))
       (if (setq s (ssget p '((0 . "*POLYLINE"))))
           (princ
               (strcat "\nVertex number: "
                    (rtos (1+ (vlax-curve-getparamatpoint (ssname s 0)  (vlax-curve-getclosestpointto (ssname s 0) (trans p 1 0)))) 2 0)
               )
           )
           (princ "\nNo polyline found at the selected point.")
       )
   )
   (princ)
)
(vl-load-com) (princ)

M.R., your lisp is very useful to my work. I'm labeling near of the vertex of the polyline randomly. With your lisp, I used it for query and label it manually with cad command. It comes in my mind that it much easier for me if after the query it will ask "pick the text location", and it will label the vertex number of the polyline of that query, until such time I press "Esc" or cancel it. Thank you for giving me a little time.

L.M., you simplified the program:). Thank you!! If you have still time please help me to include the one I ask above.

Try the following:

(defun c:vn ( / a n p q s )
   (setq n (trans '(0.0 0.0 1.0) 1 0 t)
         a (angle '(0.0 0.0 0.0) (trans (getvar 'ucsxdir) 0 n t))
   )
   (while (setq p (getpoint "\nPick vertex <Exit>: "))
       (if
           (setq s
               (ssget p
                  '(
                       (0 . "*POLYLINE")
                       (-4 . "<NOT")
                           (-4 . "<AND")
                               (0 . "POLYLINE") (-4 . "&") (70 . 80)
                           (-4 . "AND>")
                       (-4 . "NOT>")
                   )
               )
           )
           (if (setq q (getpoint "\nPick point for text: "))
               (entmake
                   (list
                      '(0 . "TEXT")
                       (cons 010 (trans q 1 n))
                       (cons 007 (getvar 'textstyle))
                       (cons 040 (getvar 'textsize))
                       (cons 001 (rtos (1+ (vlax-curve-getparamatpoint (ssname s 0) (vlax-curve-getclosestpointto (ssname s 0) (trans p 1 0)))) 2 0))
                       (cons 050 a)
                       (cons 210 n)
                   )
               )
           )
           (princ "\nNo polyline found at the selected point.")
       )
   )
   (princ)
)
(vl-load-com) (princ)

The above should also work in all UCS & Views.

You're welcome!