Sort selection sets

[Anonymous]

Hello,

I searched a lot this problem here, but I couldn't get an proper answer.

Please see the attached drawing. There are some cases to sort selection sets.

How can I handle it as per the cases?

Thanks in advance.

[Kent1Cooper]

---

@Anonymous wrote:

.... 

Please see the attached drawing. There are some cases to sort selection sets.

How can I handle it as per the cases?

....

---

Try out BlockSSSort.sp [= Block Selection Set Sort] early on this thread:
 

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Assigning-attributes-to-blocks-using-polyline-to-sequence-order/td-p/3146374/highlight/true

If you have messages listed chronologically, it's attached to message 9.  It's for Blocks specifically, sorting positionally by insertion point, but could easily be adjusted for other entity types.

Your Case 1 would be done thus:

(BSSS "L" "B")

Case 2:

(BSSS "L" "T")

Case 3:

(BSSS "T" "L")

It takes a selection set, and returns a sorted list of entity names.

[Hallex · Accepted solution]

If I've been understand this right

this code snip does your work

(setq ss nil data nil tmp nil ee nil)
  (setq ss (ssget '((0 . "text"))))
  (while (setq en (ssname ss 0))
  (setq lst (entget en)
        pt (cdr (assoc 10 lst))
        txt (cdr (assoc 1 lst)))
  (setq tmp  (cons pt txt))
  (setq data (cons tmp data))
  (ssdel en ss)
  )
(setq case1 (vl-sort data '(lambda (a b)
         (and (or (> (caar a)(caar b))
              (< (cadar a)(cadar b)))
                (<=  (caar a)(caar b))))))
(setq case2 (vl-sort data '(lambda (a b)
         (and (or (< (caar a)(caar b))
              (> (cadar a)(cadar b)))
                (<=  (caar a)(caar b))))))
(setq case3 (vl-sort data '(lambda (a b)
         (and (or (<= (caar a)(caar b))
              (>= (cadar a)(cadar b)))
                (>  (cadar a)(cadar b))))))

[Anonymous]

Hallex, you must be a genius. I greatly works for me. It doesn't look difficult but I couldn't make it. Thanks man. 🙂

[Anonymous]

Hallex,

Please see the attached drawing.

And also see below routine.

(defun c:test ()
  (setq ss   nil
 data nil
 tmp  nil
 ee   nil
  )
  (setq ss (ssget '((0 . "INSERT") (66 . 1))))
  (while (setq en (ssname ss 0))
    (setq lst (entget en)
   pt  (cdr (assoc 10 lst))
    )
    (setq tmp (cons pt en))
    (setq data (cons tmp data))
    (ssdel en ss)
  ) ; end of while
  (setq case3 (vl-sort data
         '(lambda (a b)
     (and (or (<= (caar a) (caar b))
       (>= (cadar a) (cadar b))
          )
          (> (cadar a) (cadar b))
     )
   )
       )
  )
  (setq o 0)
  (while (setq a1 (nth 0 case3))
    (setq a2 (car a1))
    (setq i (polar a2 (dtr 35.2336) 514.8099))
    (command "text" i "68.0" "0" (rtos (+ 1 o) 2 0))
    (setq o (1+ o))
    (setq case3 (cdr case3))
  ) ; end of while
) ; end of defun

(defun dtr (a) (* (/ a 180.0) pi))
(defun rtd (a) (/ (* a 180.0) pi))

BTW, an error occurred at the marked one. Please give it a try and advice me what happened.

Besides, when I use not a window selection but slecting object one by one, this doesn't work properly.

Thanks in advance.

[pbejse · Accepted solution]

(defun  c:NumB (/ aDoc op ptlst mn mx)
  (vl-load-com)
  (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    i    0
    )
  (cond
    ((and
     (progn   (initget "W S")
     (setq op (getkword "\nSelection Method [Window/Select Order] <Window>: "))
     (if (not op) (setq op "Window")) T)
     (ssget '((0 . "INSERT") (66 . 1)))
     (progn
     (vlax-for
        itm (setq ss (vla-get-ActiveSelectionSet aDoc))
       (vla-getboundingbox itm 'mn 'mx)
       (setq
         ptlst
          (cons
            (mapcar
              (function (lambda (a b) (/ (+ a b) 2.)))
              (vlax-safearray->list mn)
              (vlax-safearray->list mx)
              )
            ptlst
            )
         )
       )
     (vla-delete ss)
     T
     );progn
     (foreach
        box (if (eq op "W")
              (vl-sort
              ptlst
              (function (lambda (ip1 ip2) (< (car ip1) (car ip2))))
              )
              (reverse ptlst))
       (vlax-invoke
         (vlax-get (vla-get-ActiveLayout aDoc) 'Block)
         'AddText
         (itoa (setq i (1+ i)))
         box
         50;<--- Text Height
         )
       )
     )
    )
  )(princ)
  )

The window option would process the selecton Left to Right otherwise use the "Select Order" < S >

HTH

[pbejse · Accepted solution]

if you're going to use the code above in  conjuntion with kents code

use something like this

(defun c:NumBs (/ aDoc ss op mn mx blsort2)
  (vl-load-com)
  (setq
    aDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    i    0
    blsort2 nil;<---temp. for testing puropose
    )
  (cond
    ((and
       (progn
         (initget 1 "LB TL LT")
         (setq op (getkword "\nSelection Method [LB/TL/LT]: "))
         )
       (setq
         ss (cond
              ((eq op "LB") (BSSS "L" "B"))
              ((eq op "TL") (BSSS "T" "L"))
              ((eq op "LT") (BSSS "L" "T"))
              )
         )
       (foreach
          itm ss
         (vla-getboundingbox (vlax-ename->vla-object itm) 'mn 'mx)
         (vlax-invoke
           (vlax-get (vla-get-ActiveLayout aDoc) 'Block)
           'AddText
           (itoa (setq i (1+ i)))
           (mapcar
             (function (lambda (a b) (/ (+ a b) 2.)))
             (vlax-safearray->list mn)
             (vlax-safearray->list mx)
             )
           50                           ;<--- Text Height
           )
         )
       )
     )
    )
  (princ)
  )

I'm sure kent  will use an entirely different though  🙂

[Hallex]

Try instead, btw this is another one sorting case

(defun c:test ()
  
  (setq ss   nil
        
 data nil
        
 tmp  nil
        
 ee   nil
        
  )
  
  (setq ss (ssget '((0 . "INSERT") (66 . 1))))
  
  (while (setq en (ssname ss 0))
    
    (setq lst (entget en)
          
   pt  (cdr (assoc 10 lst))
          
    )
    
    (setq tmp (cons pt en))
    
    (setq data (cons tmp data))
    
    (ssdel en ss)
    
  ) ; end of while

  
;;;  (setq case3 (vl-sort data
;;;         '(lambda (a b)
;;;     (and (or (<= (caar a) (caar b))
;;;       (>= (cadar a) (cadar b))
;;;          )
;;;          (> (cadar a) (cadar b))
;;;     )
;;;   )
;;;       )
;;;  )

  (setq case0 (vl-sort data
                       
         '(lambda (a b)
            
     (< (caar a) (caar b)))))
  

  (setq c 1)
  
  (while (setq a1 (car case0))
    
    (setq a2 (car a1))
    
    (setq pt (polar a2 (dtr 35.2336) 514.8099))
    
    (command "_text" pt "68.0" "0.0" (itoa c))
    
    (setq c (1+ c))
    
    (setq case0 (cdr case0))
    
  ) ; end of while
  
) ; end of defun


(defun dtr (a) (* (/ a 180.0) pi))

(defun rtd (a) (/ (* a 180.0) pi))