Topic: How to select objects in an order?

[Vikram]

I have a lisp which writes the coordinates of selected lines in a notepad file. The problem happens when I want to select many lines I simply select all of them by window crossing selection on screen. But when those points are written in notepad they are not sequential. If I start selecting lines from bottom to top by drag selection they should be written from bottom top order. This lisp works if I select each line individually. I have also attached my drawing for reference.

This is the lisp.

Code: [Select]

(defun c:TesT (/ fileName selectionset)
;;; Tharwat 04. Dec. 2011 ;;;
  (if (and (setq fileName (getfiled "Name of File >>..." "" "txt" 1))
           (setq selectionset (ssget '((0 . "LINE"))))
      )
    (progn (setq filename (open filename "w"))
           ((lambda (i / namess entlist pt1 pt2)
              (while (setq namess (ssname selectionset (setq i (1+ i))))
                (setq entlist (entget namess))
                (setq pt1 (cdr (assoc 10 entlist)))
                (setq pt2 (cdr (assoc 11 entlist)))
                (write-line (strcat (rtos (car pt1) 2) "\t" (rtos (cadr pt1) 2) "\t" (rtos (caddr pt1) 2)) fileName)
                (write-line (strcat (rtos (car pt2) 2) "\t" (rtos (cadr pt2) 2) "\t" (rtos (caddr pt2) 2)) fileName)
              )
            )
             -1
           )
           (close fileName)
    )
    (princ)
  )
  (princ)
)

[didier]

Coucou / Hello

the best way is to create a polyline and then extract the vertices of the polyline
would you need help to do that ?

amicalement

[Vikram]

How to extract the vertices of the polyline?
I don't know how to make that lisp, polyline and lwpolyline supporting

[mailmaverick]

Try this routine :-

Code: [Select]

(defun c:Test (/ fileName selectionset)
;;; Mailmaverick 18-11-2019
;;; Full regards and credits to KDUB and LEE MAC for using their wonderful universal functions
;;;
  ;| -------------------------------------------------------------
                      SUPPORTING FUNCTIONS                       
     -------------------------------------------------------------
     |;
  ;; Unique  -  Lee Mac
  ;; Returns a list with duplicate elements removed.
  (defun LM:Unique (l / x r)
    (while l
      (setq x (car l)
    l (vl-remove x (cdr l))
    r (cons x r)
      )
    )
    (reverse r)
  )
  ;; Union of two selection sets and returns common elements
  (defun kdub:ssintersect (ss1 ss2 / ss l1 l2)
    (setq ss (ssadd))
    (cond ((and ss1 ss2)
   (setq l1 (kdub:ss->entlist ss1)
l2 (kdub:ss->entlist ss2)
   )
   (foreach x (vl-remove-if-not '(lambda (x) (member x l2)) l1) (ssadd x ss))
  )
  (t (setq ss nil))
    )
    ss
  )
  (defun kdub:ss->entlist (ss / i returnval)
    (if (and ss (< 0 (sslength ss)))
      (setq returnval (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    )
    returnval
  )
  ;| -------------------------------------------------------------
                        ACTUAL PROGRAM STARTED                   
     -------------------------------------------------------------
     |;
  (if (and (setq fileName (getfiled "Name of File >>..." "" "txt" 1))
   (setq selectionset (ssget '((0 . "LINE"))))
      )
    (progn (setq filename (open filename "w"))
   (setq nodelist (list))
   (setq fromlist (list))
   (setq tolist (list))
   (repeat (setq n (sslength selectionset))
     (setq ent (ssname selectionset (setq n (1- n))))
     (setq stptent (vlax-curve-getStartPoint ent))
     (setq endptent (vlax-curve-getEndPoint ent))
     (setq fromlist (cons stptent fromlist))
     (setq tolist (cons endptent tolist))
   )
   (setq nodelist (append nodelist fromlist tolist))
   (setq origfromlen (length fromlist))
   (setq origlen (length nodelist))
   (setq n 0)
   (setq nodelist1 (list)) ; nodes occuring only once in total list of all nodes
   (while (< n origlen)
     (setq pt (nth n nodelist))
     (setq count (- origlen (length (vl-remove pt nodelist))))
     (if (eq count 1)
       (setq nodelist1 (append (list pt) nodelist1))
     )
     (setq n (1+ n))
   )
   (if (/= (length nodelist1) 2)
     (progn (setq strr (strcat "\nError Number of Nodes occuring only once must be 2 but they are : "
       (itoa (length nodelist1))
       " as follows : \n"
       (foreach pt nodelist1 (strcat (vl-princ-to-string pt) "\n"))
       )
    )
    (princ strr)
    (alert strr)
    (quit)
     )
   )
   (write-line "X\tY\tZ" filename)
   (setq pt1 (car nodelist1))
   (setq pt2 (cadr nodelist1))
   (if (member pt1 fromlist)
     (progn (setq stpt pt1) (setq endpt pt2))
     (progn (setq stpt pt2) (setq endpt pt1))
   )
   ;;stpt = Start Point
   ;;endpt = End Point
   (setq pt stpt)
   (write-line (strcat (rtos (car pt) 2) "\t" (rtos (cadr pt) 2) "\t" (rtos (caddr pt) 2)) fileName)
   (setq ent nil)
   (setq found T)
   (setq fuzz 0.01)
   (while found
     (setq minx (- (car pt) fuzz))
     (setq maxx (+ (car pt) fuzz))
     (setq miny (- (cadr pt) fuzz))
     (setq maxy (+ (cadr pt) fuzz))
     (setq pta (list minx miny 0.0))
     (setq ptb (list maxx miny 0.0))
     (setq ptc (list maxx maxy 0.0))
     (setq ptd (list minx maxy 0.0))
     (if (and (setq ss2 (ssget "_CP" (list pta ptb ptc ptd) (list (cons 0 "*LINE"))))
      (if ent
(ssdel ent ss2)
T
      )
      (setq ss2 (kdub:ssintersect selectionset ss2))
)
       (progn
(cond ((> (sslength ss2) 1)
(setq errpoint pt)
(setq strr (strcat "\nError. More than 2 pipes found at Point : " (vl-princ-to-string pt)))
(close fileName)
(princ strr)
(alert strr)
(setq found nil)
       )
       ((< (sslength ss2) 1)
(setq errpoint pt)
(setq strr (strcat "\nError. No Pipe found at Point : " (vl-princ-to-string pt)))
(close fileName)
(princ strr)
(alert strr)
(setq found nil)
       )
       (T
(setq ent (ssname ss2 0))
(setq pt (vlax-curve-getEndPoint ent))
(write-line (strcat (rtos (car pt) 2) "\t" (rtos (cadr pt) 2) "\t" (rtos (caddr pt) 2)) fileName)
(if (equal pt endpt fuzz)
  (progn ;; Last Point Reached
(setq found nil)
  )
)
       )
)
       )
       (progn (setq found nil))
     )
   )
   (close fileName)
    )
  )
  (princ)
)


[didier]

Coucou / Hello

a little easier to understand to start
the separator is a semicolon and dec is the precision of the decimals
you have to answer to the file name and it will be created in the repertory of the drawing with the extension TXT

Code: [Select]

(defun c:WriteVertices ( /  NomFic f lstsom n som)
  (setq NomFic (getstring "\nFile Name ?\n"))
  (setq dec 2 sep ";")

  (if
    (setq ent (car (entsel "\nChoix de la Polyligne ...\n")))
    (progn
      (setq f (open (strcat (getvar "dwgprefix") NomFic ".txt") "w"))
      (setq lstsom (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
      (setq n 0)
      (repeat (length lstsom)
(setq som (nth n lstsom))
(write-line (strcat (rtos (car som) 2 dec) sep (rtos (cadr som) 2 dec)) f)
(setq n (1+ n))
)
      )
  );if
(close f)
(alert (strcat (itoa n) " vertices are written in the file : " (strcat (getvar "dwgprefix") NomFic ".txt")))
  )

[DEVITG]

You can use DATAEXTRACTION  and sort it by x and y . see the result . It is the same as mailmaverik's lisp , use the DXE file as source to data extraction

[Vikram]

Thanks both of you! It helped!