select similar lisp

[flopo]

(defun c:selectsimilar ( / sset)
   (if (/= (setq sset (ssget "_I")) nil)
     (setq hnd (ssname sset 0))
     (setq hnd (car (entsel "\nDS> Select Object Type: ")))
   )
   (if (/= hnd nil)
     (progn
       (setq obj (cdr (assoc 0 (entget hnd))))
       (setq sset (ssget "_X" (list (cons 0 obj))))
       (if (> (sslength sset) 0)
         (sssetfirst sset sset)
       )
     )
   )
   (princ)
 )

 

 

 

 

This lisp is from Land Development Desktop and Civil 3D. The problem is that does not select only from the object's layer. Anybody now why or hot to fix it? Thanks!

Edited November 19, 2013 by SLW210
Added code tags

[SteveK]

Hi. Object & Layer?

 

(defun c:selectsimilar ( / SSET HND LAY OBJ)
 (if (/= (setq sset (ssget "_I")) nil)
   (setq hnd (ssname sset 0))
   (setq hnd (car (entsel "\nDS> Select Object Type: ")))
   )
 (if (/= hnd nil)
   (progn
     (setq obj (cdr (assoc 0 (entget hnd)))
       lay (cdr (assoc 8 (entget hnd))))
     (setq sset (ssget "_X" (list (cons 0 obj)(cons 8 lay))))
     (if (> (sslength sset) 0)
   (sssetfirst sset sset)
   )
     )
   )
 (princ)
 )

[flopo]

Thanks, Is Perfect!

Somebody Showed Me A Lisp That Draw Similar Object, In The Same Layer. Have Any Idea About A Lisp To Do This?

[SteveK]

How would that lisp be different to the "Copy" command?

[flopo]

That lisp is very similar with a Copy command, the difference is that when i use this lisp for a dimension, it will ask me point for dimensioning, and when i use it for a circle will ask for centerpoint and radius.... is like using the same command used for drawing the first object ( dimension or circle....etc), but making current the layer of the first object...

I saw this kind of routine that even made current the dimension style used for a dimension - when the object selected as a model was a dimension.

I have no idea about making Lisps, but i think this is not a simple Lisp - this lisp exist, somebody showed me - but only SHOWED ...

[SteveK]

Is typing "C" for circle and "MA" for match properties so hard lol.

 

Anyways yeah a lisp like that sounds big... maybe you could search for the command if you remember it.

[flopo]

http://www.cadtutor.net/forum/showthread.php?t=37532&highlight=mapcom

This routine is perfect... if will work with dimension ant text also...

[alanjt]

Here's my version of SelectSimilar. It has a few more options.

 

 

...and yes, it does allow for pickfirst.

[Commandobill]

I wrote this when i wrote a draw order lisp

 

;******************************Selection Set Options************************************************************
(defun ssop ( / ssmeth s1 ss)
 (initget "1 2 3 4")
 (setq ssmeth (cond ((getkword "\nSelect by: (1)-Specified Objects (2)-Layer (3)-Blockname (4)-Similar - <Specified Objects> : ")) ("1")))
 (setq curt (getvar "ctab"))
 (cond ((= ssmeth "1")
    (setq ss(ssget)))
   ((= ssmeth "2")
    (if (setq ss (entsel "\nSelect an object on the layer you want: "))
      (ssget "X" (list (cons 410 curt) (cons 8 (cdr (assoc 8 (entget (car ss)))))))))
   ((= ssmeth "3")
    (if (setq ss (entsel "\nSelect a block: "))
      (if (= (cdadr (setq ss (entget (car ss)))) "INSERT")
        (setq ss (ssget "X" (list (cons 410 curt) (cons 2 (cdr (assoc 2 ss)))))))
      ))
   ((= ssmeth "4")
    (if (setq ss (entsel "\nSelect an object: "))
      (progn
        (if (= (cdadr (setq ss (entget (car ss)))) "INSERT")
          (setq s1 (cons 2 (cdr (assoc 2 ss))))
          (setq s1 (cons 0 (cdr (assoc 0 ss)))))
        (setq ss (ssget "X" (list s1 (cons 410 curt) (cons 8 (cdr (assoc 8 ss)))))))
      )))
 )

[alanjt]

I wrote this when i wrote a draw order lisp

 

;******************************Selection Set Options************************************************************
(defun ssop ( / ssmeth s1 ss)
 (initget "1 2 3 4")
 (setq ssmeth (cond ((getkword "\nSelect by: (1)-Specified Objects (2)-Layer (3)-Blockname (4)-Similar - <Specified Objects> : ")) ("1")))
 (setq curt (getvar "ctab"))
 (cond ((= ssmeth "1")
    (setq ss(ssget)))
   ((= ssmeth "2")
    (if (setq ss (entsel "\nSelect an object on the layer you want: "))
      (ssget "X" (list (cons 410 curt) (cons 8 (cdr (assoc 8 (entget (car ss)))))))))
   ((= ssmeth "3")
    (if (setq ss (entsel "\nSelect a block: "))
      (if (= (cdadr (setq ss (entget (car ss)))) "INSERT")
        (setq ss (ssget "X" (list (cons 410 curt) (cons 2 (cdr (assoc 2 ss)))))))
      ))
   ((= ssmeth "4")
    (if (setq ss (entsel "\nSelect an object: "))
      (progn
        (if (= (cdadr (setq ss (entget (car ss)))) "INSERT")
          (setq s1 (cons 2 (cdr (assoc 2 ss))))
          (setq s1 (cons 0 (cdr (assoc 0 ss)))))
        (setq ss (ssget "X" (list s1 (cons 410 curt) (cons 8 (cdr (assoc 8 ss)))))))
      )))
 )

 

 

 

Very cool!

[Commandobill]

Yeah i like it cause it's simple but very useful

[alanjt]

Yeah i like it cause it's simple but very useful

I assume you call it from other routines.

[SteveK]

We all think alike Here's the two I use:

;;; Custom Selection using Entity
;;; Steve K
(defun c:se2 (/ ss en sock dxfcodes)
 
 (If (setq en (car(entsel "\nSelect Entity: ")))
   (progn
     (foreach n (vl-sort (entget en) (function (lambda (a b) (< (car a) (car b)))))
       (print n)) ;(textscr)

     (while (and (not (initget 4))
         (setq sock (getint "\nEnter a DXF code do you want to filter? [Enter when done]: ")))
   (if (assoc sock (entget en))
     (setq dxfcodes (cons (assoc sock (entget en)) dxfcodes))
     (princ "\nDXF Code does not exist in entity."))
   (terpri)
   (princ dxfcodes)
   )

     (If dxfcodes
   (progn
     (princ "\nSelected Filters: \n")
     (princ dxfcodes)
     
     (princ "\nSelect objects [Enter for all]: ")
     (if (null (setq ss (ssget dxfcodes)))
       (setq ss (ssget "_X" dxfcodes)))
     
     (sssetfirst nil ss)
     (princ (strcat "\n" (if ss (itoa (sslength ss)) "0") " Entities Selected.\n"))
     )(princ "\nNo DXF Codes Input.\n"))
     )(princ "\nNo Entity Selected.\n")
   )

 (princ)
 )

and

;;; Provides tabled filter options for Selection
;;; Steve K
(defun c:se4 (/ ss TBLNAMES tblName tblNum lst count specNum dxfCodes)
 (setq TBLNAMES (list
          nil            ; 0
          '("LAYER" .     ; 1
          '("BLOCK" . 2)    ; 2
          '("LTYPE" . 6)    ; 3
          '("STYLE" . 7)    ; 4
          '("COLOUR" . 62)    ; 5
          '("MANUAL" . nil)    ; 6
          )
   dxfCodes (list (cons 410 (getvar "CTAB"))) ; Add tab to filter.
   )
 
 (while (and (not (initget 6))
         (setq tblNum (getint (strcat "\nSpecify Table Number [Enter when done]:\n"
                      "[1 = Layers]\n"
                      "[2 = Blocks]\n"
                      "[3 = LineTypes]\n"
                      "[4 = Styles]\n"
                      "[5 = Colours]\n"
                      "[6 = Manually Enter]\n: "))))
   (Cond ((setq tblName (nth tblNum TBLNAMES))
      (Cond
        ; Colour Filter
        ((eq (car tblName) "COLOUR")
         (If (and (not (initget 6))
              (setq specNum (getint "\nEnter the Colour Index Number: "))
              (< specNum 256))
       (If (assoc (cdr tblName) dxfCodes)
         (setq dxfCodes (subst (cons (cdr tblName)
                         (strcat (cdr (assoc (cdr tblName) dxfCodes)) "," (cdr (nth specNum lst))))
                   (assoc (cdr tblName) dxfCodes)
                   dxfCodes))
         (setq dxfCodes (cons (cons (cdr tblName) specNum) dxfCodes)))
       (princ "\nNumber not recognised.\n")
       ))
        ; Manually Enter
        ((eq (car tblName) "MANUAL")
         (If (and (not (initget 4))
              (setq specNum (getint "\nEnter a DXF Code: "))
              (setq specStr (getstring T "\nEnter a Label for the DXF Code: ")))
       (If (assoc specNum dxfCodes)
         (setq dxfCodes (subst (cons specNum
                         (strcat (cdr (assoc specNum dxfCodes)) "," specStr))
                   (assoc specNum dxfCodes)
                   dxfCodes))
         (setq dxfCodes (cons (cons specNum specStr) dxfCodes)))
       ))
        ; All Others
        (T
         (setq count 0
           lst (list nil))
         (foreach val (vl-sort (ai_table (car tblName) 3) '<)
       (setq count (1+ count)
             lst (cons (cons count val) lst))
       (princ (strcat "\n" (itoa count) " = " val))
       )
         (setq lst (reverse lst))
         (If (and (not (initget 6))
              (setq specNum (getint "\nEnter a corresponding Number to Filter: "))
              (nth specNum lst))
       (If (assoc (cdr tblName) dxfCodes)
         (setq dxfCodes (subst (cons (cdr tblName)
                         (strcat (cdr (assoc (cdr tblName) dxfCodes)) "," (cdr (nth specNum lst))))
                   (assoc (cdr tblName) dxfCodes)
                   dxfCodes))
         (setq dxfCodes (cons (cons (cdr tblName) (cdr (nth specNum lst))) dxfCodes)))
       (princ "\nNumber not recognised.\n")
       )
         )
        )
      )
     (T
      (princ "\nNumber not recognised.\n")
      )
     )
   (princ "\nCurrent Filtered List: \n")
   (princ dxfCodes)
   )

 (if dxfCodes
   (progn
     (princ "\nFinal Filtered List: \n")
     (princ dxfCodes)
     (princ "\nSelect objects [Enter for all]: ")
     (if (null (setq ss (ssget dxfCodes)))
   (setq ss (ssget "_X" dxfCodes)))
     (if ss
   (progn
     (princ (strcat "\n" (itoa (sslength ss)) " Entities Selected.\n"))
     (sssetfirst nil ss)
     )
   (princ "\nNothing Found.\n"))
     )(princ "\nNothing Filtered. Exiting..\n"))
     
 (princ)
 )

[SteveK]

Steve, are these yours? Very nice stuff!

Lol, yep, thanks.

 

Here's another one I use:

That's pretty neat.

 

Should've made a thread for this cause I'd be interested to see what other lispers have come up with as "Alternatives to Quick Select". I guess it's all slight variations to suit the needs of the particular job.

[ghostware]

Download the Select Similar with DCL that Gilles Chanteau made. I use it almost every day, works great.

 

 

SEL-SS.zip

[SteveK]

Thanks for sharing Pascal, I like it. Do you remember the original thread?

[ghostware]

I don't now The original thread:

 

;; Select all objects wich have the same properties as those of

;; selected object which are

;; toggled in dialog box.

;;

;; SEL-SS Slect All object with same properties

;; SEL-SSF Multiple entity filter and choise to select all of pick

SEL-MATCH.zip

[golfdogz]

Hi All

 

im having an issue with the select similar - which i have been using fine for years now - but all of a sudden the delete key will not delete items when selected via select similar command.. wierdly it is not the usual 'pickfirst' issue - as the delete key still works when selected normally. and it is also weird that multiple select similar lsp's yield the same effect.. can anyone help out?

 

(edit) and actually even stranger is del key works after i have slightly panned while selection set is highlighted?? same thing is happening to others in my office so im wondering if maybe a windows update has hapened...

 

this one ive been using as an example (from the second post in this thread)

(defun c:selectsimilar ( / SSET HND LAY OBJ)  
(if (/= (setq sset (ssget "_I")) nil)     
(setq hnd (ssname sset 0))     
(setq hnd (car (entsel "\nDS> Select Object Type: ")))     )  
(if (/= hnd nil)    
(progn       
(setq obj (cdr (assoc 0 (entget hnd)))         
lay (cdr (assoc 8 (entget hnd))))       
(setq sset (ssget "_X" (list (cons 0 obj)(cons 8 lay))))       
(if (> (sslength sset) 0)     
(sssetfirst sset sset)     )       )     )   
(princ)   )

Edited November 19, 2013 by golfdogz