Select similar for current window view

[Anonymous]

Dear Helpers,

Please help me out from my requirement by modifying below code with select similar for current viewable screen.

The below code is asking for window selection, instaed of current screen.

(defun c:SSW (/ filter ss1 ss2 ss3 add i e)
  ;; Select Similar within Window
  ;; Uses core SelectSimilar command
  ;; Alan J. Thompson, 2013.07.30
  (setq filter (if (eq (getvar 'CVPORT) 1)
                 (list (cons 410 (getvar 'CTAB)))
                 '((410 . "Model"))
               )
  )
  (princ "\nSelect objects to select similar: ")
  (if (and (setq ss1 (ssget filter))
           (progn (princ "\nSelect area to select similar object(s) within: ")
                  (setq ss2 (ssget filter))
           )
      )
    (progn (command "_.selectsimilar" ss1 "")
           (if (setq ss3 (ssget "_I" filter))
             (progn (sssetfirst nil nil)
                    (setq add (ssadd))
                    (repeat (setq i (sslength ss3))
                      (if (ssmemb (setq e (ssname ss3 (setq i (1- i)))) ss2)
                        (setq add (ssadd e add))
                      )
                    )
                    (sssetfirst nil add)
             )
           )
    )
  )
  (princ)
)

[dbhunia]

Try this

(defun c:SSW (/ filter ss1 ss2 ss3 add i e)
  ;; Select Similar within Window
  ;; Uses core SelectSimilar command
  ;; Alan J. Thompson, 2013.07.30
  (setq filter (if (eq (getvar 'CVPORT) 1)
                 (list (cons 410 (getvar 'CTAB)))
                 '((410 . "Model"))
               )
  )
  (princ "\nSelect objects to select similar: ")
  (if (and (setq ss1 (ssget filter))
           ;(progn (princ "\nSelect area to select similar object(s) within: ")
           ;       (setq ss2 (ssget filter))
           ;)
	   (setq ss2 (ssget "_A"))
      )
    (progn (command "_.selectsimilar" ss1 "")
           (if (setq ss3 (ssget "_I" filter))
             (progn (sssetfirst nil nil)
                    (setq add (ssadd))
                    (repeat (setq i (sslength ss3))
                      (if (ssmemb (setq e (ssname ss3 (setq i (1- i)))) ss2)
                        (setq add (ssadd e add))
                      )
                    )
                    (sssetfirst nil add)
             )
           )
    )
  )
  (princ)
)

[Anonymous]

Dear Sir,

Thank for Responding, I need the lisp code, that should select for current zoom window only, not for entire drawing. That means, that should work for current zoom limits only.

[dbhunia]

Ok I am on the way to home, give me one hour.....

Inbetween this check this. ..

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ssget-only-visible-entities/td-p/182...

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/upperleft-and-lowerright-corner/td-p...

[dbhunia]

Try this..... (This approach taken from the given link)

(defun c:SSW (/ filter ss1 ss2 ss3 add i e ptlist)
  ;; Select Similar within Window
  ;; Uses core SelectSimilar command
  ;; Alan J. Thompson, 2013.07.30
  (setq filter (if (eq (getvar 'CVPORT) 1)
                 (list (cons 410 (getvar 'CTAB)))
                 '((410 . "Model"))
               )
  )
  (princ "\nSelect objects to select similar: ")
  (if (and (setq ss1 (ssget filter))
	   (GETSCREENCOORDS)
	   (setq ss2 (ssget "WP" ptlist))
	   ;(setq ss2 (ssget "CP" ptlist));;use for cross window selection
      )
    (progn (command "_.selectsimilar" ss1 "")
           (if (setq ss3 (ssget "_I" filter))
             (progn (sssetfirst nil nil)
                    (setq add (ssadd))
                    (repeat (setq i (sslength ss3))
                      (if (ssmemb (setq e (ssname ss3 (setq i (1- i)))) ss2)
                        (setq add (ssadd e add))
                      )
                    )
                    (sssetfirst nil add)
             )
           )
    )
  )
  (princ)
)
(defun GetScreenCoords ( / viewname viewdata vctr vwidth ctrx ctry xmin xmax ymin ymax)
(command "-view" "s" "tempview")
(setq viewname (tblobjname "view" "tempview")
      viewdata (entget viewname)
      vctr (cdr (assoc 10 viewdata))
      vwidth (cdr (assoc 41 viewdata))
      vheight (cdr (assoc 40 viewdata))
      ctrx (car vctr)
      ctry (cadr vctr)
)
(setq xmin (- ctrx (/ vwidth 2.0))
      xmax (+ ctrx (/ vwidth 2.0))
      ymin (- ctry (/ vheight 2.0))
      ymax (+ ctry (/ vheight 2.0))
)
(setq ptlist (list (list xmin ymin) (list xmax ymin) (list xmax ymax) (list xmin ymax)))
)

Another thing I can not test "(command "_.selectsimilar" ss1 "")" in AutoCAD 2007, so I am unable to test the entire code.......

[Anonymous]

What will be the reason for the following error, Sir.

Command: SSW
Select objects to select similar:
Select objects: 1 found

Select objects:  -view Enter an option [?/Delete/Orthographic/Restore/Save/sEttings/Window]: s Enter view name to save: tempview
UCSVIEW = 1  UCS will be saved with view
Command:

[dbhunia]

I did not get any error.......

Post your Drawing....

Or Try this....

(defun c:SSW (/ filter ss1 ss2 ss3 add i e ptlist)
  ;; Select Similar within Window
  ;; Uses core SelectSimilar command
  ;; Alan J. Thompson, 2013.07.30
  (setvar 'cmdecho 0)
  (setq filter (if (eq (getvar 'CVPORT) 1)
                 (list (cons 410 (getvar 'CTAB)))
                 '((410 . "Model"))
               )
  )
  (princ "\nSelect objects to select similar: ")
  (if (and (setq ss1 (ssget filter))
	   (GETSCREENCOORDS)
	   (setq ss2 (ssget "WP" ptlist))
	   ;(setq ss2 (ssget "CP" ptlist));;use for cross window selection
      )
    (progn (command "_.selectsimilar" ss1 "")
           (if (setq ss3 (ssget "_I" filter))
             (progn (sssetfirst nil nil)
                    (setq add (ssadd))
                    (repeat (setq i (sslength ss3))
                      (if (ssmemb (setq e (ssname ss3 (setq i (1- i)))) ss2)
                        (setq add (ssadd e add))
                      )
                    )
                    (sssetfirst nil add)
             )
           )
    )
  )
  (setvar 'cmdecho 1)
  (princ)
)
(defun GetScreenCoords ( / viewname viewdata vctr vwidth ctrx ctry xmin xmax ymin ymax)
(command "-view" "s" "tempview")
(setq viewname (tblobjname "view" "tempview")
      viewdata (entget viewname)
      vctr (cdr (assoc 10 viewdata))
      vwidth (cdr (assoc 41 viewdata))
      vheight (cdr (assoc 40 viewdata))
      ctrx (car vctr)
      ctry (cadr vctr)
)
(setq xmin (- ctrx (/ vwidth 2.0))
      xmax (+ ctrx (/ vwidth 2.0))
      ymin (- ctry (/ vheight 2.0))
      ymax (+ ctry (/ vheight 2.0))
)
(setq ptlist (list (list xmin ymin) (list xmax ymin) (list xmax ymax) (list xmin ymax)))
)

[Anonymous]

Please find attached dwg Sir.

[dbhunia · Accepted solution]

Try this....

(defun c:SSW (/ filter ss1 ss2 ss3 add i e  CurSet ScrPts)
  ;; Select Similar within Window
  ;; Uses core SelectSimilar command
  ;; Alan J. Thompson, 2013.07.30
  (setvar 'cmdecho 0)
  (setq filter (if (eq (getvar 'CVPORT) 1)
                 (list (cons 410 (getvar 'CTAB)))
                 '((410 . "Model"))
               )
  )
  (princ "\nSelect objects to select similar: ")
  (if (and (setq ss1 (ssget filter)
	         ScrPts (GetScreenCoords)
		 ss2 (ssget "C" (car ScrPts) (cadr ScrPts))
	   )
      )
    (progn (command "_.selectsimilar" ss1 "")
           (if (setq ss3 (ssget "_I" filter))
             (progn (sssetfirst nil nil)
                    (setq add (ssadd))
                    (repeat (setq i (sslength ss3))
                      (if (ssmemb (setq e (ssname ss3 (setq i (1- i)))) ss2)
                        (setq add (ssadd e add))
                      )
                    )
                    (sssetfirst nil add)
             )
           )
    )
  )
  (setvar 'cmdecho 1)
  (princ)
)
(defun GetScreenCoords ( / ViwCen ViwDim ViwSiz VptMin VptMax)
(setq ViwSiz (/ (getvar "VIEWSIZE") 2.0)
      ViwCen (getvar "VIEWCTR")
      ViwDim (list (* ViwSiz (apply '/ (getvar "SCREENSIZE"))) ViwSiz)
      VptMin (mapcar '- ViwCen ViwDim)
      VptMax (mapcar '+ ViwCen ViwDim)
)
(list VptMin VptMax)
)

[Anonymous]

Dear Sir,

Can you please update the same code for select similar inside a selected polygon. 

Thanking you in advance Sir.

[dbhunia]

Try this ..... Lightly tested..

(defun c:SSW (/ filter ss1 ss2 ss3 add i e lst)
  ;; Select Similar within Window
  ;; Uses core SelectSimilar command
  ;; Alan J. Thompson, 2013.07.30
  (setvar 'cmdecho 0)
  (setq filter (if (eq (getvar 'CVPORT) 1)
                 (list (cons 410 (getvar 'CTAB)))
                 '((410 . "Model"))
               )
  )
  (princ "\nSelect objects to select similar: ")
  (if (and (setq ss1 (ssget filter)
		 lst (Poly_Cor_Extr 10 (entget (car (entsel "\nSelect Polygon..."))))
 		 ss2 (ssget "_WP" lst)
	   )
      )
    (progn (command "_.selectsimilar" ss1 "")
           (if (setq ss3 (ssget "_I" filter))
             (progn (sssetfirst nil nil)
                    (setq add (ssadd))
                    (repeat (setq i (sslength ss3))
                      (if (ssmemb (setq e (ssname ss3 (setq i (1- i)))) ss2)
                        (setq add (ssadd e add))
                      )
                    )
                    (sssetfirst nil add)
             )
           )
    )
  )
  (setvar 'cmdecho 1)
  (princ)
)
(defun Poly_Cor_Extr (key cor / val cor_list)
   (foreach val cor
	(if (eq key (car val)) (setq cor_list (cons (cdr val) cor_list)))
   )
(reverse cor_list)
)

[Anonymous]

Dear Sir,

Can you please update lisp code is, it should select all blocks with insertion points inside them. The present code is not working for selection of blocks, if small geometry of block is falling outside the polygon, even the insertion point is inside the polygon.

Thanks in advacne Sir.

[dani-perez]

Hello  dbhunia,

I tried the code, but it displays and error message (Translated): "Aplication Error: SSGET PT waits for one or two points"

[dbhunia · Accepted solution]

Try this ...... Lightly tested......(Only for block selection)

(defun c:SSW (/ filter ss1 ss2 ss3 add i e ent obj BP)
  (vl-load-com)
  (setvar 'cmdecho 0)
  (setq filter (if (eq (getvar 'CVPORT) 1)
                 (list (cons 410 (getvar 'CTAB)))
                 '((410 . "Model")(0 . "INSERT"))
               )
  )
  (princ "\nSelect objects to select similar: ")
  (if (and (setq ss1 (ssget filter)
		 ent (car (entsel "\nSelect Polyline: "))
	   )
      )
    (if (vlax-method-applicable-p (setq obj (vlax-ename->vla-object ent)) 'intersectwith)
        (progn (command "_.selectsimilar" ss1 "")
           (if (setq ss3 (ssget "_I" filter))
               (progn (sssetfirst nil nil)
                    (setq add (ssadd))
                    (repeat (setq i (sslength ss3))
                        (setq BP (cdr (assoc 10 (entget (setq e (ssname ss3 (setq i (1- i))))))))
                      	(if (LM:PointInside-p (trans BP 1 0) obj) (setq add (ssadd e add)))
                    )
                    (sssetfirst nil add)
               )
           )
        )
        (princ "\nInvalid Object selected.")
    )
  )
  (setvar 'cmdecho 1)
  (princ)
)
(defun LM:PointInside-p ( pt obj / lst ray )
   (setq lst
       (vlax-invoke
           (setq ray
               (vla-addray
                   (vla-objectidtoobject (vla-get-document obj) (vla-get-ownerid obj))
                   (vlax-3D-point pt)
                   (vlax-3D-point (mapcar '+ pt '(1.0 0.0 0.0)))
               )
           )
           'intersectwith obj acextendnone
       )
   )
   (vla-delete ray)
   (= 1 (logand 1 (length lst)))
)

[dbhunia]

Can you post your Drawing....

[dani-perez]

Hello  dbhunia,

Here is a sample drawing. I tried the first code (SSW) to selectsimilar in zoom. My autocad is not in English.

Thanks.

[dbhunia]

@dani-perez in such type of Drawing it is not possible to find out any type of problem (at least for me).....so I am sorry, can't help you......

Let's see if any one can help you......