Jump to content

LISP to Select and Sort


geocad

Recommended Posts

Hello all,

 

I have a drawing which has many circle objects at different depths and with different color coding in one layer. Is there a LISP which will automatically select all the objects in a defined depth range (such as 0 to -1, -1 to -2, etc) and put them into a layer named for that depth range? A secondary objective would be able to sort by color, but depth is the most important. If not how difficult would it be for someone such as myself, with no code writing experience to write that routine? Thanks.

 

Josh

Link to comment
Share on other sites

  1. Select objects.
  2. Iterate through selection set, if object Z value matches certain criteria, put on specific layer. Cond would be the easiest.

Have a list of what goes where?

Link to comment
Share on other sites

Hello all,

 

I have a drawing which has many circle objects at different depths and with different color coding in one layer. Is there a LISP which will automatically select all the objects in a defined depth range (such as 0 to -1, -1 to -2, etc) and put them into a layer named for that depth range? A secondary objective would be able to sort by color, but depth is the most important. If not how difficult would it be for someone such as myself, with no code writing experience to write that routine? Thanks.

 

Josh

(setq circleselection (ssget "X" 
(list (cons 0  "CIRCLE")
'(-4 . "< AND")
'(-4 . "*,*,>")
(cons 10 (list 0. 0. -0.99999999)
'(-4 . "*,*,<")
(cons 10 (list 0. 0. -2.00000001)
'(-4 . "AND >")
)))

this filter will be select all circles with depth range from -1 to -2

Hope this make a sense

 

~'J'~

Link to comment
Share on other sites

Maybe something like this:

 

(defun c:Test (/ #SS #Layers #Z)
 (vl-load-com)
 (cond
   ((setq #SS (ssget "_:L"))
    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    (setq #Layers (vla-get-layers *AcadDoc*))
    (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex #SS)))
      (if (or (setq #Z (cdr (assoc 38 (entget x))))
              (setq #Z (last (assoc 10 (entget x))))
          ) ;_ or
        (cond
          ;; <= 0
          ((<= #Z 0.)
           (or (tblsearch "layer" "A")
               (vla-put-color (vla-add #Layers "A") 1)
           ) ;_ or
           (vla-put-layer (vlax-ename->vla-object x) "A")
          )
          ;; 0 < x < 5
          ((and (> #Z 0.) (< #Z 5.))
           (or (tblsearch "layer" "B")
               (vla-put-color (vla-add #Layers "B") 2)
           ) ;_ or
           (vla-put-layer (vlax-ename->vla-object x) "B")
          )
        ) ;_ cond
      ) ;_ if
    ) ;_ foreach
   )
 ) ;_ cond
 (princ)
) ;_ defun

Link to comment
Share on other sites

  1. Select objects.
  2. Iterate through selection set, if object Z value matches certain criteria, put on specific layer. Cond would be the easiest.

Have a list of what goes where?

 

I am not sure what you mean by "Iterate through selection set, " Are you referring to Quick Select each depth range? If so, I have done this, but I am looking for an automated way of doing this.

 

If I misunderstood your response I apologize. I appreciate the help.

Link to comment
Share on other sites

(setq circleselection (ssget "X" 
(list (cons 0  "CIRCLE")
'(-4 . "< AND")
'(-4 . "*,*,>")
(cons 10 (list 0. 0. -0.99999999)
'(-4 . "*,*,<")
(cons 10 (list 0. 0. -2.00000001)
'(-4 . "AND >")
)))

this filter will be select all circles with depth range from -1 to -2

Hope this make a sense

 

~'J'~

 

I am showing my ignorance here as I could not get this lisp to run. Did I miss something?

Link to comment
Share on other sites

I am not sure what you mean by "Iterate through selection set, " Are you referring to Quick Select each depth range? If so, I have done this, but I am looking for an automated way of doing this.

 

If I misunderstood your response I apologize. I appreciate the help.

 

Look at my #4 post.

Link to comment
Share on other sites

Maybe something like this:

 

(defun c:Test (/ #SS #Layers #Z)
 (vl-load-com)
 (cond
   ((setq #SS (ssget "_:L"))
    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    (setq #Layers (vla-get-layers *AcadDoc*))
    (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex #SS)))
      (if (or (setq #Z (cdr (assoc 38 (entget x))))
              (setq #Z (last (assoc 10 (entget x))))
          ) ;_ or
        (cond
          ;; <= 0
          ((<= #Z 0.)
           (or (tblsearch "layer" "A")
               (vla-put-color (vla-add #Layers "A") 1)
           ) ;_ or
           (vla-put-layer (vlax-ename->vla-object x) "A")
          )
          ;; 0 < x < 5
          ((and (> #Z 0.) (< #Z 5.))
           (or (tblsearch "layer" "B")
               (vla-put-color (vla-add #Layers "B") 2)
           ) ;_ or
           (vla-put-layer (vlax-ename->vla-object x) "B")
          )
        ) ;_ cond
      ) ;_ if
    ) ;_ foreach
   )
 ) ;_ cond
 (princ)
) ;_ defun

 

I successfully ran this lisp, but it put all of the objects into the layer "A". All of the objects have Z positions less than zero. In other words they are all negative. I tried to alter the lisp, but was unsuccessful. What should I change to have it select the objects from -1 to -1.99999999, for example? I think if I could figure out that part of the code I could copy and paste to reiterate for the other depth ranges. I think this is on the correct track. Thanks again. Your help is really appreciated.

Link to comment
Share on other sites

I successfully ran this lisp, but it put all of the objects into the layer "A". All of the objects have Z positions less than zero. In other words they are all negative. I tried to alter the lisp, but was unsuccessful. What should I change to have it select the objects from -1 to -1.99999999, for example? I think if I could figure out that part of the code I could copy and paste to reiterate for the other depth ranges. I think this is on the correct track. Thanks again. Your help is really appreciated.

 

 

Right, I had to make it as generic as possible, since you didn't give the amounts.

 

Look at this portion:

           ;; 0 < x < 5
          [color=Red]((and (> #Z 0.) (< #Z 5.)) ; checks if greater than 0 and less than 5[/color]
           (or (tblsearch "layer" "B")
               (vla-put-color (vla-add #Layers "B") 2)
           ) ;_ or
           (vla-put-layer (vlax-ename->vla-object x) "B")
          )

Link to comment
Share on other sites

Right, I had to make it as generic as possible, since you didn't give the amounts.

 

Look at this portion:

           ;; 0 < x < 5
          [color=Red]((and (> #Z 0.) (< #Z 5.)) ; checks if greater than 0 and less than 5[/color]
           (or (tblsearch "layer" "B")
               (vla-put-color (vla-add #Layers "B") 2)
           ) ;_ or
           (vla-put-layer (vlax-ename->vla-object x) "B")
          )

 

I believe that works. Thanks for your time. I will use this to try and learn the commands used in lisp.

 

Thanks again.

Link to comment
Share on other sites

I believe that works. Thanks for your time. I will use this to try and learn the commands used in lisp.

 

Thanks again.

 

It did when I tested it earlier. :)

 

If you need any more help, don't hesitate to ask. :)

Link to comment
Share on other sites

I am showing my ignorance here as I could not get this lisp to run. Did I miss something?

 

I meant something like this one

 

(defun C:demo  (/)
 (setq	range_list (list '(0 -1) '(-1 -2) '(-2 -3) '(-3 -4)) ;etc
precision  0.00000001)

 (foreach item	 range_list
   (setq circleselection
   (ssget "_X"
	  (list
	    '(0 . "CIRCLE")
	    '(-4 . "<AND")
	    '(-4 . "*,*,>")
	    (cons 10 (list 0. 0. (- (cadr item) precision)))
	    '(-4 . "*,*,<")
	    (cons 10 (list 0. 0. (+ (car item) precision)))
	    '(-4 . "AND>")
	    )))
   (if	circleselection
     (alert (strcat "Selected: "
	     (itoa (sslength circleselection))
	     " circles\n"
	     "at range from "
	     (rtos (car item))
	     " to "
	     (rtos (cadr item)))))
   )
 (princ)
 )

 

~'J'~

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