Select similar length of objects in drawing

July 9, 2020

Hello All...

I need lisp routine as below procedure:

1. Run command

2.Select Any Line or Poly line Object or Circles

3. Then automatically select similar Length of remaining objects in entire drawing too.

After that above task, I have to do for move selected objects or delete or copy...Etc.

Please help.

July 9, 2020

;;;;;;;   http://mistressofthedorkness.blogspot.com/2006/07/i-know-how-to-pick-em-selectsimilar.html
;;; Select Similar
;;; (based on a command found in a few versions of AutoCAD)
;;; written by Adam Wuellner
;;; all rights released

;--------> MAIN ROUTINE
(defun c:selsim  (/ ss1 i ent filter_list type-layer filter sstemp)
  (if (not (setq ss1 (cadr (ssgetfirst))))
    (setq ss1 (ssget)))
  (setq i           0
        filter_list '())
  (repeat (sslength ss1)
    (setq ent (entget (ssname ss1 i))
          i   (1+ i))
    (setq type-layer (list (assoc 0 ent) (assoc 8 ent)))
    (if (not (member type-layer filter_list))
      (setq filter_list (cons type-layer filter_list))))
  (foreach filter  filter_list
    (princ (strcat "selecting all " (cdar filter) " entities on layer " (cdadr filter) "...\n"))
    (setq sstemp (ssget "X" filter))
    (setq ss1    (ss:union ss1 sstemp)
          sstemp nil))
  (sssetfirst nil ss1)
  (princ))




;--------> UNION
(defun ss:union  (ss1 ss2 / ename ss-smaller ss-larger c)
  (cond ((and ss1 ss2)
         (setq c 0)
         (if (< (sslength ss1) (sslength ss2))
           (setq ss-smaller ss1
                 ss-larger ss2)
           (setq ss-larger ss1
                 ss-smaller ss2))
         (while (< c (sslength ss-smaller))
           (setq ename (ssname ss-smaller c)
                 c     (1+ c))
           (if (not (ssmemb ename ss-larger))
             (ssadd ename ss-larger)))
         ss-larger)
        (ss1 ss1)
        (ss2 ss2)
        (t nil)))

Edited July 9, 2020 by hosneyalaa
ADD

July 9, 2020

Hello, i create a simple lisp for selection pline with same lenght its not very good but you can try it.

Later i will update it with lines and circles.

;;Create by Georgi Georgiev	- TRUDY
;;Date: 09.07.2020

(defun c:sel (/)
(setq sel1 (ssget ":S" '((0 . "LWPOLYLINE"))))
(setq clear nil)
(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
			(setq len (vla-get-length (vlax-ename->vla-object nam)))
)
;
(setq selall (ssget "X" '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength selall))
			(setq namall (ssname selall (setq i (1- i))))
			(setq entall (entget namall))
			(setq lenall (vla-get-length (vlax-ename->vla-object namall)))
				(if (= len lenall) (setq clear (ssadd namall sel1)) (princ))		
)
(sssetfirst nil clear)
(princ)
)

July 9, 2020

2 hours ago, hosneyalaa said:


;;;;;;;   http://mistressofthedorkness.blogspot.com/2006/07/i-know-how-to-pick-em-selectsimilar.html
;;; Select Similar
;;; (based on a command found in a few versions of AutoCAD)
;;; written by Adam Wuellner
;;; all rights released

;--------> MAIN ROUTINE
(defun c:selsim  (/ ss1 i ent filter_list type-layer filter sstemp)
  (if (not (setq ss1 (cadr (ssgetfirst))))
    (setq ss1 (ssget)))
  (setq i           0
        filter_list '())
  (repeat (sslength ss1)
    (setq ent (entget (ssname ss1 i))
          i   (1+ i))
    (setq type-layer (list (assoc 0 ent) (assoc 8 ent)))
    (if (not (member type-layer filter_list))
      (setq filter_list (cons type-layer filter_list))))
  (foreach filter  filter_list
    (princ (strcat "selecting all " (cdar filter) " entities on layer " (cdadr filter) "...\n"))
    (setq sstemp (ssget "X" filter))
    (setq ss1    (ss:union ss1 sstemp)
          sstemp nil))
  (sssetfirst nil ss1)
  (princ))




;--------> UNION
(defun ss:union  (ss1 ss2 / ename ss-smaller ss-larger c)
  (cond ((and ss1 ss2)
         (setq c 0)
         (if (< (sslength ss1) (sslength ss2))
           (setq ss-smaller ss1
                 ss-larger ss2)
           (setq ss-larger ss1
                 ss-smaller ss2))
         (while (< c (sslength ss-smaller))
           (setq ename (ssname ss-smaller c)
                 c     (1+ c))
           (if (not (ssmemb ename ss-larger))
             (ssadd ename ss-larger)))
         ss-larger)
        (ss1 ss1)
        (ss2 ss2)
        (t nil)))

Hi Thank you for making, with help of your code, selected different lengths of remaining lines too. i need select the the remaining lines or Lw poly lines which are having same lengths.

July 9, 2020

22 minutes ago, Trudy said:

Hello, i create a simple lisp for selection pline with same lenght its not very good but you can try it.

Later i will update it with lines and circles.


;;Create by Georgi Georgiev	- TRUDY
;;Date: 09.07.2020

(defun c:sel (/)
(setq sel1 (ssget ":S" '((0 . "LWPOLYLINE"))))
(setq clear nil)
(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
			(setq len (vla-get-length (vlax-ename->vla-object nam)))
)
;
(setq selall (ssget "X" '((0 . "LWPOLYLINE"))))
(repeat (setq i (sslength selall))
			(setq namall (ssname selall (setq i (1- i))))
			(setq entall (entget namall))
			(setq lenall (vla-get-length (vlax-ename->vla-object namall)))
				(if (= len lenall) (setq clear (ssadd namall sel1)) (princ))		
)
(sssetfirst nil clear)
(princ)
)

Hi it is working for LW poly lines, Thank you. can you please make for ordinary lines and circles too.

Edited July 9, 2020 by structo

July 9, 2020

I think after few hours i will create, say if you want to select in some range maybe (mm, cm, m, ...) or exactly same length.

July 9, 2020

Just now, Trudy said:

I think after few hours i will create, say if you want to select in some range maybe (mm, cm, m, ...) or exactly same length.

Need Exactly same length

July 9, 2020

Try this:

(defun c:foo (/ _getlength e l l2 r s)
  ;; RJP » 2020-07-09
  ;; Select objects with similar length
  (defun _getlength (e / ep)
    (if	(vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
      0.
      (vlax-curve-getdistatparam e ep)
    )
  )
  (cond	((and (setq e (car (entsel "\nPick an object to set length filter: "))) (setq s (ssget)))
	 (setq r (ssadd))
	 (setq l (_getlength e))
	 (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (and (setq l2 (_getlength x)) (equal l l2 1e-4) (ssadd x r))
	 )
	 (sssetfirst nil r)
	)
  )
  (princ)
)

July 9, 2020

I finish the code work with circle select with radius and plines and lines

;;Create by Georgi Georgiev	- TRUDY
;;Date: 09.07.2020

(defun c:sel (/)
 (vl-load-com)
 (setq clear nil)
(setq sel1 (ssget ":S" '((0 . "LWPOLYLINE,line,circle"))))

(repeat (setq i (sslength sel1))
		(setq nam (ssname sel1 (setq i (1- i))))
		(setq ent (entget nam))
		(princ (cdr (assoc 0 ent)))
			(if (= (cdr (assoc 0 ent)) "CIRCLE")
				(setq rad (cdr (assoc 40 ent)))
				(setq len (vla-get-length (vlax-ename->vla-object nam)))
			)
)

(setq selall (ssget "X" (list (assoc 0 ent))))
(repeat (setq i (sslength selall))
			(setq namall (ssname selall (setq i (1- i))))
			(setq entall (entget namall))
				(if (= (cdr (assoc 0 ent)) "CIRCLE")
					(setq radall (cdr (assoc 40 entall)))
					(setq lenall (vla-get-length (vlax-ename->vla-object namall)))
				)
				(if (= (cdr (assoc 0 ent)) "CIRCLE")
					(if (= rad radall) (setq clear (ssadd namall sel1)) (princ))
					(if (= len lenall) (setq clear (ssadd namall sel1)) (princ))
				)
)
(sssetfirst nil clear)
(princ)
)

If you need some change tell

Hope to help you

July 9, 2020

@Trudy the equal symbol '=' does not work in comparing real / decimal numbers with each other so you need to use equal function with tolerance / fuzz factor and you can take a close look at the codes that @ronjonp posted above.

July 10, 2020

12 hours ago, Trudy said:
I finish the code work with circle select with radius and plines and lines
 
If you need some change tell

Hope to help you

No need to change it is working fine, Thank you very much Trudy

July 10, 2020

13 hours ago, ronjonp said:
Try this:
 

This version also Brilliant, Thank you very much ronjonp

July 10, 2020

5 hours ago, structo said:

This version also Brilliant, Thank you very much ronjonp

Glad to help. The code should work with any object so you're not limited.

December 23, 2021

On 7/10/2020 at 2:37 AM, ronjonp said:

Try this:


(defun c:foo (/ _getlength e l l2 r s)
  ;; RJP » 2020-07-09
  ;; Select objects with similar length
  (defun _getlength (e / ep)
    (if	(vl-catch-all-error-p (setq ep (vl-catch-all-apply 'vlax-curve-getendparam (list e))))
      0.
      (vlax-curve-getdistatparam e ep)
    )
  )
  (cond	((and (setq e (car (entsel "\nPick an object to set length filter: "))) (setq s (ssget)))
	 (setq r (ssadd))
	 (setq l (_getlength e))
	 (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (and (setq l2 (_getlength x)) (equal l l2 1e-4) (ssadd x r))
	 )
	 (sssetfirst nil r)
	)
  )
  (princ)
)

i really like this code this help me alot, but please kindly edit for my purpose to

change multiple lenght given instead window selection and change the result selection to curent active layer or set to layer name given in code also

manny thanks before sir

Sign In

Select similar length of objects in drawing

Recommended Posts

structo

hosneyalaa

Trudy

structo

structo

Trudy

structo

ronjonp

Trudy

Tharwat

structo

structo

ronjonp

uzumaki narudin

Join the conversation

Tutorials

Forums

Activity