Jump to content

Select similar length of objects in drawing


structo

Recommended Posts

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.

Link to comment
Share on other sites

;;;;;;;   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 by hosneyalaa
ADD
Link to comment
Share on other sites

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)
)

 

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 by structo
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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👍

Link to comment
Share on other sites

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)
)

 

  • Like 2
Link to comment
Share on other sites

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 :)

  • Thanks 1
Link to comment
Share on other sites

@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.

Link to comment
Share on other sites

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🙂👍

Link to comment
Share on other sites

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. 😉

Link to comment
Share on other sites

  • 1 year later...
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
 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...