degraded QSE in command line

[exceed]

;; QQSE - QSE in Command Line
(defun c:QQSE ( / *error* old_osmode startrange endrange p2 p4 ss ssl ssindex typelist typestacklist ssl ent entname type typestacklist lst result item typeuniquelist tull tulindex tulstack tullist restxt tula tulb userinput1 typeselected ss2 ss2l ss2index colorstacklist layerstacklist ent2 ent2color ent2layer csll lsll cslindex lslindex cslstack lslstack clist llist csla cslb lsla lslb ctlistl ctindex csltxt ltlistl ltindex lsltxt secondfilteranswer ss3 e c ss3l )

  (setvar 'cmdecho 0)
  (setq old_osmode (getvar 'osmode))
  (setvar 'osmode 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))
        )
        (setvar 'osmode old_osmode)       
        (setvar 'cmdecho 1)
       
        (redraw)
        (princ)
    )


    (if
        (and
            (setq startrange (getpoint "\n Set Range for Quick Selection - Start Point "))
            (setq endrange (getcorner startrange "\n Set Range to Quick Selection - End Point "))
        )
        (progn
            (setq p2 (list (car endrange) (cadr startrange))
                  p4 (list (car startrange) (cadr endrange))
            )
            (grvecs (list -1 startrange p2 p2 endrange endrange p4 p4 startrange))
        )
    )
(redraw)
(princ)


(setq ss (ssget "c" startrange endrange))
(sssetfirst nil ss)

(setq ssl (sslength ss))
(setq ssindex 0)
(setq typelist nil)
(setq typestacklist nil)

(repeat ssl
  (setq ent (entget (ssname ss ssindex)))
  (setq entname (cdr (assoc -1 ent)))
  (setq type (cdr (assoc 0 ent)))
  (setq typestacklist (cons type typestacklist))
  (setq ssindex (+ ssindex 1))
)

(defun CountItems ( Lst / Item Result )
(foreach x Lst
(setq Result
   (if (setq Item (assoc x Result))
      (subst (cons x (1+ (cdr Item))) Item Result)
      (cons (cons x 1) Result)
   )
)
)
(reverse Result)
)

(setq typeuniquelist (CountItems typestacklist))

(setq tull (length typeuniquelist))
(setq tulindex 0)
(setq tulstack (list (list 0 "SELECT_ALL" 0)))
(setq tullist nil)
(setq restxt "\n Selection No. <0> SELECT ALL")
(repeat tull
  (setq tula (car (nth tulindex typeuniquelist)))
  (setq tulb (cdr (nth tulindex typeuniquelist)))
  (setq tullist (list (+ tulindex 1) tula tulb))
  (setq restxt (strcat restxt "\n Selection No. <" (vl-princ-to-string (+ tulindex 1)) "> " (vl-princ-to-string tula) " = " (vl-princ-to-string tulb) " ea "))
  (setq tulstack (cons tullist tulstack))
  (setq tulindex (+ tulindex 1))
)

;(setq tulstack (cons (list 99 "DUMMY" 0) tulstack))
(setq tulstack (vl-sort tulstack '(lambda (x y) (< (car x)(car y)))))
;(princ tulstack)
(princ restxt)

(defun userinputter ( / userinput1 )
(initget 5)
(setq userinput (getint "\n Input Number to Select : "))
(if (> userinput tulindex)
   (progn (princ "\n wrong number ")
             (princ restxt)
             (userinputter)
   ) 
)
)

(userinputter)
;(princ tulstack)

(setq typeselected (cadr (nth userinput tulstack)))
(princ "\n ") 
(princ typeselected)
(princ " is selected.")

(if (= typeselected "SELECT_ALL")
(setq ss2 (ssget "c" startrange endrange))
(setq ss2 (ssget "c" startrange endrange (list (cons 0 typeselected)) ))
)
(sssetfirst nil ss2)
;(princ ss)

         
          (setq ss2l (sslength ss2))
          (setq ss2index 0)
          (setq colorstacklist nil)
          (setq layerstacklist nil)
          (repeat ss2l 
            (setq ent2 (entget (ssname ss2 ss2index)))
            (setq ent2color (cdr (assoc 62 ent2)))
            (setq ent2layer (cdr (assoc 8 ent2)))
            (setq colorstacklist (cons ent2color colorstacklist))
            (setq layerstacklist (cons ent2layer layerstacklist))
            (setq ss2index (+ ss2index 1))
          )
          (setq colorstacklist (CountItems colorstacklist))
          (setq layerstacklist (CountItems layerstacklist))
          ;(princ colorstacklist)
         
          (setq csll (length colorstacklist))
          (setq lsll (length layerstacklist))
          (setq cslindex 0)
          (setq lslindex 0)
          (setq cslstack nil)
          (setq lslstack nil)
          (setq clist nil)
          (setq llist nil)

          (repeat csll
            (setq csla (car (nth cslindex colorstacklist)))
            (setq cslb (cdr (nth cslindex colorstacklist)))
            (setq clist (list csla cslb))
            (setq cslstack (cons clist cslstack))
            (setq cslindex (+ cslindex 1))
          )

          (repeat lsll
            (setq lsla (car (nth lslindex layerstacklist)))
            (setq lslb (cdr (nth lslindex layerstacklist)))
            (setq llist (list lsla lslb))
            (setq lslstack (cons llist lslstack))
            (setq lslindex (+ lslindex 1))
          )

          (setq cslstack (vl-sort cslstack '(lambda (x y) (< (car x)(car y)))))
          (setq lslstack (vl-sort lslstack '(lambda (x y) (< (car x)(car y)))))

          (setq ctlistl (length cslstack))
          (setq ctindex 0)
          (setq csltxt " ")        

          (repeat ctlistl
            (setq csltxt (strcat csltxt "\n Color Code < " (vl-princ-to-string (car (nth ctindex cslstack))) " >   =   " (vl-princ-to-string (cadr (nth ctindex cslstack))) " ea "))
            (setq ctindex (+ ctindex 1))
          )

          (setq ltlistl (length lslstack))
          (setq ltindex 0)
          (setq lsltxt " ")        

          (repeat ltlistl
            (setq lsltxt (strcat lsltxt "\n Layer Name < " (vl-princ-to-string (car (nth ltindex lslstack))) " >   =   " (vl-princ-to-string (cadr (nth ltindex lslstack))) " ea "))
            (setq ltindex (+ ltindex 1))
          )



(initget 1 "A C L T")
(setq secondfilteranswer (getkword "\n 2nd Filter - All (A) / By Color (C) / By Layer (L) / By Textcontents (T): "))
(cond 
  ((= secondfilteranswer "A") (setq ss3 (ssget "_p")))
  ((= secondfilteranswer "C")
    (if (setq e (car (entsel (strcat csltxt "\n Select the object which color you want to find (Press SpaceBar for Input color code by manual input)"))))
       (progn
           (setq c (cdr (assoc 62 (entget e)))) 
       );progn
       (progn
          (initget 1)
          (setq c (getint "\n Or Input by Manual : "))
       )
   );if

          (setq ss3 (ssget "_p" (list (cons 62 c))))


  );cond c
  ((= secondfilteranswer "L")
   (if (setq e (car (entsel (strcat lsltxt "\n Select the object which Layer you want to find (Press SpaceBar for Layer Name by manual input)"))))
       (progn
           (setq c (cdr (assoc 8 (entget e)))) 
       );progn
       (progn
          (initget 1)
          (setq c (getstring t "\n Or Input by Manual : "))
       )
   );if
          (setq ss3 (ssget "_p" (list (cons 8 c))))
  );cond l
  ((= secondfilteranswer "T")
   (if (setq e (car (entsel (strcat "\n Select the object which Values you want to find (Press SpaceBar for Values by manual input)"))))
       (progn
           (setq c (cdr (assoc 1 (entget e)))) 
       );progn
       (progn
          (initget 1)
          (setq c (getstring t "\n Or Input by Manual : "))
       )
   );if
          (setq ss3 (ssget "_p" (list (cons 1 c))))
  );cond l

);cond






(if (= ss3 nil) 
   (progn 
     (princ "\n There are no objects that satisfy your filter condition.")
     (sssetfirst nil nil)
   )
   (progn 
     (sssetfirst nil ss3)
     (setq ss3l (sslength ss3))
     (princ (strcat "\n Selection Complete! Result - " (vl-princ-to-string (sslength ss3)) " ea."))
   )
)

(LM:endundo (LM:acdoc))
(setvar 'osmode old_osmode)       
(setvar 'cmdecho 1)
(princ)
)


;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc_forrf 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc_forrf)
)


;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo_forrf doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

 

 

I have referred Select by color, find text lisp

I'd like to use QSE, but why there's no "-QSE"....

 

so, this is a degraded imitation of QSE

can filter Object type, Color, Layer, Text contents only.

 

like this

 Set Range for Quick Selection - Start Point 
 Set Range to Quick Selection - End Point 
 Selection No. <0> SELECT ALL
 Selection No. <1> TEXT = 392 ea 
 Selection No. <2> LINE = 196 ea 
 Selection No. <3> LWPOLYLINE = 23 ea 
 Selection No. <4> CIRCLE = 6 ea 
 Selection No. <5> ARC = 5 ea 
 Selection No. <6> MTEXT = 114 ea 
 Input Number to Select : 1
 TEXT is selected.
 2nd Filter - All (A) / By Color (C) / By Layer (L) / By Textcontents (T): t
 Select the object which Values you want to find (Press SpaceBar for Values by manual input)
 Or Input by Manual : 0096
 Selection Complete! Result - 4 ea.

[mhupp]

I find if I need to select things over and over ill build a simple SSGET. When I have a need to use QSE its to find niche things like arc's on a layer that are smaller than or equal to x radius.

 

;;----------------------------------------------------------------------------;;
;; Select Similar Objects command shortcut
(defun C:SS ()
  (vl-cmdf "_Selectsimilar")
)

;;----------------------------------------------------------------------------;;
;; Filter Down Selection to Blocks only
(defun C:SB (/ SS)
  (if (ssget "_I")  ; If there are preselected objects [= Implied selection]
    (sssetfirst nil (ssget "_I" '((0 . "INSERT"))))  ; Select Only Blocks among them
    (sssetfirst nil (ssget "_:L" '((0 . "INSERT"))))
  )

  (princ)
)

 

[exceed]

On 2/18/2022 at 10:54 PM, mhupp said:

I find if I need to select things over and over ill build a simple SSGET. When I have a need to use QSE its to find niche things like arc's on a layer that are smaller than or equal to x radius.

 

;;----------------------------------------------------------------------------;;
;; Select Similar Objects command shortcut
(defun C:SS ()
  (vl-cmdf "_Selectsimilar")
)

;;----------------------------------------------------------------------------;;
;; Filter Down Selection to Blocks only
(defun C:SB (/ SS)
  (if (ssget "_I")  ; If there are preselected objects [= Implied selection]
    (sssetfirst nil (ssget "_I" '((0 . "INSERT"))))  ; Select Only Blocks among them
    (sssetfirst nil (ssget "_:L" '((0 . "INSERT"))))
  )

  (princ)
)

 

It helps my routine.

You pointed out exactly what I didn't know.

I'll study some more.