Sort Selectionset by X & Y Coordinate

[neam]

Hi everyone:

I want to extract the text data inside the circles and write it in a text file.

But I can't sort and number them based on the X axis and then on the Y axis.

I want the numbering to be done incrementally on the X axis first, and the numbering to continue based on the Y axis.

I also used Peter's function.

Thank you for your guidance.

[EnM4st3r]

Peters function "SortSelectionSetByXYZ" already does that.
Sorting result will be in this order: X -> Y -> Z

[neam]

Hi

Thanks you for reply.

Please see attachment.

it is ok:

it is not ok:

[EnM4st3r · Accepted solution]

so the sorting order you want is
not: X > Y > Z

but: +Y > -Y > X

right?

But your cyan circles and green circles do not share the same Y coordinates so the result would still be diffrent.

Edit: also some of the green do not have the same y coordinate as other green circles

Here i have changed the sorting to Y > X

(defun c:circlecount ( / *error* round sortListofSublistsbyItemX SelectionSetToList ListToSelectionSet SortSelectionSetByXYZ
                      doc des borders num wtxt wtxtfnl objects ib r c1 col typ us ds km of p1 p2 obj nultxt nu list1 t1 str sum)
  
  (defun *error* (msg)
    (if des (close des))
    (if doc (vla-endundomark doc))
    (princ (strcat "Error: " msg))
    (princ)
  )
  
  (defun round (num decimals)
    (atof (rtos num 2 decimals))
  )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;  by Peter from AUGI Forum (Sort Selectionset by X coord) ;;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun sortListofSublistsbyItemX (lstOfSublists) 
    ;; car = ename | cadr = x | caddr = y | cadddr = z
    (vl-sort lstOfSublists '(lambda (X Y) (if (= (round (caddr X) 2)(round (caddr Y) 2)) ; if y coordinates are the same
                                            (< (cadr X)(cadr Y)) ; sort by x
                                            (< (caddr X)(caddr Y)))) ; otherwise sort by y
    )
  )

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun SelectionSetToList (ssSelections / intCount lstReturn)
    (if (and ssSelections 
              (= (type ssSelections) 'PICKSET)
        )
      (repeat (setq intCount (sslength ssSelections))
        (setq intCount  (1- intCount)
              lstReturn (cons (ssname ssSelections intCount) lstReturn)
        )
      )
    )
    (reverse lstReturn)
  )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun ListToSelectionSet (lstOfEntities / ssReturn)
    (if lstOfEntities      
      (foreach entItem lstOfEntities
        (if (= (type entItem) 'ENAME)
          (if ssReturn 
            (setq ssReturn (ssadd entItem ssReturn))
            (setq ssReturn (ssadd entItem))
          )
        )
      )
    )
    ssReturn
  )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun SortSelectionSetByXYZ (ssSelections /  lstOfSelections lstOfSublists lstSelections)
    (if
      (and 
        (setq lstSelections (SelectionSetToList ssSelections))
        (setq lstOfSublists (mapcar '(lambda (X)(cons X (cdr (assoc 10 (entget X))))) lstSelections))
        (setq lstOfSublists (sortlistofsublistsbyitemX lstOfSublists)) ;sorted list
        (setq ssSelections  (listtoselectionset (mapcar 'car lstOfSublists)))
      )
      ssSelections
    )
  )
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;  by Peter from AUGI Forum (Sort Selectionset by X coord) ;;;;;;;;;;;;;;
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (setq des (open "Z:\\Zwischenablage\\log.txt" "w"))
  (setq borders (ssget '((0 . "CIRCLE") (-4 . "<OR")
                      (40 . 0.3)
                      (40 . 0.4)
                      (40 . 0.45)
                      (40 . 0.15)
                    (-4 . "OR>")))
  )
  (setq borders (SortSelectionSetByXYZ borders))
  (setq num 1)
  (command "CECOLOR" 7)
  (setq wtxtfnl ())
  (setq ib 0)
  (while (< ib (sslength borders)) 
    (setq wtxt ())
    (setq c1 (entget (ssname borders ib)))
    (setq r (cdr (assoc 40 c1))) ; 40=radius
    (setq wtxt (append (list (rtos num 2 0)) wtxt))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq col (cdr (assoc 62 c1)))
    (if (= col 1) 
      (setq typ "P")
    )
    (if (= col 4) 
      (setq typ "S")
    )
    (if (= col 3) 
      (setq typ "T")
    )
    (if (= col 6) 
      (setq typ "Q")
    )
    (setq wtxt (append (list typ) wtxt))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (if (< (cadr (cdr (assoc 10 c1))) 0) 
      (progn 
        (setq us "U")
        (setq wtxt (append (list us) wtxt))
      )
    )
    (if (>= (cadr (cdr (assoc 10 c1))) 0) 
      (progn 
        (setq ds "D")
        (setq wtxt (append (list ds) wtxt))
      )
    )
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq km (rtos (car (cdr (assoc 10 c1))) 2 2))
    (setq wtxt (append (list km) wtxt))
    (setq of (rtos (cadr (cdr (assoc 10 c1))) 2 2))
    (setq wtxt (append (list of) wtxt))
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq p1 (polar (cdr (assoc 10 c1)) -45 (- (+ r r))))
    (setq p2 (polar (cdr (assoc 10 c1)) -45 (+ r r)))
    (setq obj (ssget "_W" p1 p2 '((0 . "TEXT"))))
    (if (= obj nil) 
      (progn 
        (setq nultxt "No Construction")
        (setq wtxt (append (list nultxt) wtxt))
      )
    )
    (if (/= obj nil) 
      (progn 
        (setq nu (sslength obj))
        (if (> nu 1) 
          (progn 
            (setq list1 ())
            (repeat nu 
              (setq t1 (entget (ssname obj (setq nu (1- nu)))))
              (setq str (atoi (cdr (assoc 1 t1))))
              (setq list1 (append (list str) list1))
            )
            (setq sum (rtos (apply '+ list1) 2 0))
            (setq wtxt (append (list sum) wtxt))
          )
        )
        (if (= nu 1) 
          (progn 
            (setq t1 (entget (ssname obj 0)))
            (setq str (cdr (assoc 1 t1)))
            (setq wtxt (append (list str) wtxt))
          )
        )
      )
    )
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (setq wtxtfnl (reverse wtxt))
    (prin1 wtxtfnl des)
    (write-line "" des)
    (command "_-style" "Romand3" "Romantic" r "" "" "" "")
    (command "text" "_J" "_MC" (cdr (assoc 10 c1)) "0" (rtos num 2 0))
    (setq num (+ num 1))
    (setq ib (1+ ib))
  )
  (close des)
  (vla-endundomark doc)
  (princ)
)

[neam]

It works a little messy:

[neam]

dear EnM4st3r:

It is possible to consider the value of X and Y without a decimal value.

Because the circles are not carefully drawn in place. And they have some movement.

[EnM4st3r]

so i have edited the code above to compare rounded y-values instead of the actual ones.
Also i have added a undo marker so its easier to undo..

see if thats better. Sorting is still only Y > X

[neam]

Thank you very much

It works very well.

🙏🙏

[_gile]

Hi,

This way sorts the points as you show in the picture.

(vl-sort points
	 '(lambda (p1 p2)
	    (if	(equal (cadr p1) (cadr p2) 0.01)
	      (< (car p1) (car p2))
	      (if (and (< 0 (cadr p1))
		       (< 0 (cadr p2))
		  )
		(< (cadr p1) (cadr p2))
		(< (cadr p2) (cadr p1))
	      )
	    )
	  )
)

[EnM4st3r]

ohh, didnt know you could just use equal with a fuzz to compare the numbers rounded