Jump to content

Recommended Posts

Posted (edited)
(defun c:layerElev ( / ss clayer i pline elevation layername )
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (setq clayer (getvar "CLAYER"))
  (if ss
    (progn
      (setq i -1)
      (repeat (sslength ss)
        (setq i (1+ i)
              pline (ssname ss i)
              elevation (cdr (assoc 38 (entget pline)))
        )
        (cond 
          ( (<= elevation 669.99999999) (setq layername "NO_ELEV") )
          ( (= (rem (fix elevation) 2) 1) (setq layername (strcat "CONTOUR_EL" (itoa (1+ (fix elevation))))) )
          ( t (setq layername (strcat "CONTOUR_EL" (itoa (fix elevation)))) )
        )
        (command "_.layer" "_make" layername "")
        (command "_.change" pline "" "_Properties" "_LAyer" layername "")
      )
    )
  )
  (setvar "CLAYER" clayer)
  (princ)
)

 

 

I use this to put polylines on each layer by elevation.
thanks to this site... Now my question is, is it possible to make this work on all polylines?
like 3dPolyline, 2dPolyline, Polyline, and the one I am using now, which is LWPolyline.
so that I will not have to explode the polylines, and then join them again.
because sometimes, when there are too much polylines to explode and join,
my unit crashes, and its time consuming to do it over again.
so I am asking for help...

Edited by ktbjx
Posted
3 minutes ago, ktbjx said:

(defun c:layerElev ( / ss clayer i pline elevation layername )
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (setq clayer (getvar "CLAYER"))
  (if ss
    (progn
      (setq i -1)
      (repeat (sslength ss)
        (setq i (1+ i)
              pline (ssname ss i)
              elevation (cdr (assoc 38 (entget pline)))
        )
        (cond 
          ( (<= elevation 669.99999999) (setq layername "NO_ELEV") )
          ( (= (rem (fix elevation) 2) 1) (setq layername (strcat "CONTOUR_EL" (itoa (1+ (fix elevation))))) )
          ( t (setq layername (strcat "CONTOUR_EL" (itoa (fix elevation)))) )
        )
        (command "_.layer" "_make" layername "")
        (command "_.change" pline "" "_Properties" "_LAyer" layername "")
      )
    )
  )
  (setvar "CLAYER" clayer)
  (princ)
)

 

 

I use this to put polylines on each layer by elevation.
thanks to this site... Now my question is, is it possible to make this work on all polylines?
like 3dPolyline, 2dPolyline, Polyline, and the one I am using now, which is LWPolyline.
so that I will not have to explode the polylines, and then join them again.
because sometimes, when there are too much polylines do explode and join,
my unit crashes, and its time consuming to do it over again.
so I am asking for help...

 

3dPolylines have multiple elevations (z coordinates) how would that work?

Posted
1 minute ago, dlanorh said:

 

3dPolylines have multiple elevations (z coordinates) how would that work?

in 3dPolyline I need the Vertex Z(I'm basing the elevation in Vertex Z), IDK if that helps clarify???

because when you explode 3dpolyline, it becomes line. and the location Z is the vertex Z. and when you join the LINE it becomes polyline, and the location Z becomes elevation

Posted
13 minutes ago, ktbjx said:

in 3dPolyline I need the Vertex Z(I'm basing the elevation in Vertex Z), IDK if that helps clarify???

because when you explode 3dpolyline, it becomes line. and the location Z is the vertex Z. and when you join the LINE it becomes polyline, and the location Z becomes elevation

 

I understand that, but you want to assign polylines to layers with a name based on their elevation property, see below snippet from your  code)

 

 (cond 
   ( (<= elevation 669.99999999) (setq layername "NO_ELEV") )
   ( (= (rem (fix elevation) 2) 1) (setq layername (strcat "CONTOUR_EL" (itoa (1+ (fix elevation))))) )
   ( t (setq layername (strcat "CONTOUR_EL" (itoa (fix elevation)))) )
 )

 

How do you define the elevation of a 3dPolyline or line, that can have multiple points that satisfy two of the above conditions. For instance one end of a single line can have a z coordinate of 750.00 and the other end a z coordinate of 755.00. What is the layer called in this example "CONTOUR_EL750", "CONTOUR_EL755" or something inbetween?

Posted (edited)
3 hours ago, dlanorh said:

How do you define the elevation of a 3dPolyline or line, that can have multiple points that satisfy two of the above conditions. For instance one end of a single line can have a z coordinate of 750.00 and the other end a z coordinate of 755.00. What is the layer called in this example "CONTOUR_EL750", "CONTOUR_EL755" or something inbetween?

 

its the start point. if the starting z coordinate is 750, it will be on "CONTOUR_EL750",

but if the starting z coordinate is 755, it will be on "CONTOUR_EL755"

is that possible? im sorry i wish i could help.

Edited by ktbjx
Posted (edited)

OK. Try this.

 

(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (setq n_lst nil)
  (cond ( (and o_lst (= (rem (length o_lst) grp) 0))
          (while o_lst
            (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
            (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
          );end_while
        )
  );end_cond
  (if n_lst (reverse n_lst))
);end_defun

(vl-load-com)

(defun c:layerElev ( / c_doc c_lyrs ss clyr cnt pl_obj p_lst elev lyr_txt)
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        clyr (getvar 'clayer)
  );end_setq

  (prompt "\nSelect Polylines : ")
  (setq ss (ssget '((0 . "*POLYLINE"))))

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq pl_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))

            (cond ( (vlax-property-available-p pl_obj 'elevation) (setq elev (vlax-get pl_obj 'elevation))) ;;LWPolylines Polylines and 2DPolylines
                  (t
                    (setq p_lst (rh:sammlung_n (vlax-get pl_obj 'coordinates) 3)
                          elev (caddr (car p_lst))
                    );end_setq
                  )
            );end_cond

            (cond ( (< elev 700.0) (setq lyr_txt "NO_ELEV"))
                  ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev))))))
                  (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev)))))
            );end_cond

            (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt))
            (vlax-put-property pl_obj 'layer lyr_txt)
          );end_repeat
        )
  );end_cond

  (setvar 'clayer clyr)
  (princ)
);end_defun

This has been minimally test, and utilises some visual lisp hence the inclusion of (vl-load-com). It works in my small scale test. There is no local error sub.

Edited by dlanorh
spelling
  • Like 1
Posted

Nice 1 dlanorh LWPolylines Polylines and 2DPolylines have a property "elevation" 3d polys do not.

 

If the plines are contours which it often is then startpoint is sufficient for the Z value required for the 3dpolys.

 

Posted
On 10/29/2019 at 6:18 AM, dlanorh said:

OK. Try this.

 


(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (setq n_lst nil)
  (cond ( (and o_lst (= (rem (length o_lst) grp) 0))
          (while o_lst
            (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
            (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
          );end_while
        )
  );end_cond
  (if n_lst (reverse n_lst))
);end_defun

(vl-load-com)

(defun c:layerElev ( / c_doc c_lyrs ss clyr cnt pl_obj p_lst elev lyr_txt)
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        clyr (getvar 'clayer)
  );end_setq

  (prompt "\nSelect Polylines : ")
  (setq ss (ssget '((0 . "*POLYLINE"))))

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq pl_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))

            (cond ( (vlax-property-available-p pl_obj 'elevation) (setq elev (vlax-get pl_obj 'elevation))) ;;LWPolylines Polylines and 2DPolylines
                  (t
                    (setq p_lst (rh:sammlung_n (vlax-get pl_obj 'coordinates) 3)
                          elev (caddr (car p_lst))
                    );end_setq
                  )
            );end_cond

            (cond ( (< elev 700.0) (setq lyr_txt "NO_ELEV"))
                  ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev))))))
                  (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev)))))
            );end_cond

            (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt))
            (vlax-put-property pl_obj 'layer lyr_txt)
          );end_repeat
        )
  );end_cond

  (setvar 'clayer clyr)
  (princ)
);end_defun

This has been minimally test, and utilises some visual lisp hence the inclusion of (vl-load-com). It works in my small scale test. There is no local error sub.

 

 

Exactly what i need! wow and its so fast!

thant you so much! this will be very useful to me

  • 2 years later...
Posted

Can i ask if this code work in this example:

0.0001 - 2.0000 => CONTOUR_EL 2

2.0001 - 4.0000 => CONTOUR_EL 4

4.0001 - 6.0000 => CONTOUR_EL 6

And so on

OR

900.0001 - 902.0000 => CONTOUR_EL 902

902.0001 - 904.0000 => CONTOUR_EL 904

904.0001 - 906.0000 => CONTOUR_EL 906

And so on

Thank you again sir godbless you always. 

Posted
Just now, LIBRAT said:

Can i ask if this code work in this example:

0.0001 - 2.0000 => CONTOUR_EL 2

2.0001 - 4.0000 => CONTOUR_EL 4

4.0001 - 6.0000 => CONTOUR_EL 6

And so on

OR

900.0001 - 902.0000 => CONTOUR_EL 902

902.0001 - 904.0000 => CONTOUR_EL 904

904.0001 - 906.0000 => CONTOUR_EL 906

And so on

Thank you again sir godbless you always. 

 

 

I guess you have a drawing set up like this? Try it and see if it works, if not let us know where it doesn't work and someone might be able to work out a solution

 

Posted

900.000 to 901.9999 goes to "Contour_El 900" sir. 

Posted

900.0001 to 902 goes to "Contour_El 902" sir. 

Posted (edited)

If you look at this you will need to make lots of conds checking what is Z value it would make sense if a real big range 0 - 70 steps 10 to do a defun that compares.

 

( (< elev 700.0) (setq lyr_txt "NO_ELEV"))

( (<= elev 699.99999) (setq lyr_txt "ELEV_700"))

( (<= elev 689.99999) (setq lyr_txt "ELEV_680"))

Edited by BIGAL
  • Thanks 1
Posted (edited)
On 5/23/2022 at 8:42 PM, LIBRAT said:

Can i ask if this code work in this example:

0.0001 - 2.0000 => CONTOUR_EL 2

2.0001 - 4.0000 => CONTOUR_EL 4

4.0001 - 6.0000 => CONTOUR_EL 6

And so on

OR

900.0001 - 902.0000 => CONTOUR_EL 902

902.0001 - 904.0000 => CONTOUR_EL 904

904.0001 - 906.0000 => CONTOUR_EL 906

And so on

Thank you again sir godbless you always. 

            (cond ( (< elev 700.0) (setq lyr_txt "NO_ELEV"))
                  ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev))))))
                  (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev)))))
            );end_cond

second line is what you want.

 

1. (fix elev) = fix that elevation number. Drop the decimal and change to an integer.

(fix 0.0001) = 0

(fix 0.9999) = 0

(fix 1.0001) = 1

(fix 1.9999) = 1

 

2. (rem number1 number2) = [ number1 / number2 ]'s remain, Returns the remainder of the result of dividing number1 by number2.

so, (rem number1 2) = This divides number1 by 2. Then the result is only 1 or 0. This will determine if number1 is odd or even, and so on.

if result is 1 = number1 is odd

if result is 0 = number1 is even

 

3. (= (remnumber1 2) 1) = if it's odd number.

(1+ (fix elev)) = make it even by plus 1

Then its result will always be even. 0,2,4,6.. that will be layer name

 

4. itoa = number(integer) to text string, for make it to layer name

 

5. in 3rd line (t ~~~ is for already it's even number.

so, directly make it as layer name.

 

=======================================================

so, if you just want it always roundup. ( If it is enough to divide by even numbers without changing the range )

like example

900.0001 - 902.0000 => CONTOUR_EL 902

902.0001 - 904.0000 => CONTOUR_EL 904

904.0001 - 906.0000 => CONTOUR_EL 906

 

just +2 to elev. 

(setq elev (+ elev 2))

and If you want to use less than 700, you can also remove the limit as follows. 

            (setq elev (+ elev 2)) ;edited line
            (cond
                  ;( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ;edited line
                  ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev))))))
                  (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev)))))
            );end_cond

 

(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (setq n_lst nil)
  (cond ( (and o_lst (= (rem (length o_lst) grp) 0))
          (while o_lst
            (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
            (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
          );end_while
        )
  );end_cond
  (if n_lst (reverse n_lst))
);end_defun

(vl-load-com)

(defun c:layerElev ( / c_doc c_lyrs ss clyr cnt pl_obj p_lst elev lyr_txt)
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        clyr (getvar 'clayer)
  );end_setq

  (prompt "\nSelect Polylines : ")
  (setq ss (ssget '((0 . "*POLYLINE"))))

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq pl_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))

            (cond 
                  ( (vlax-property-available-p pl_obj 'elevation) (setq elev (vlax-get pl_obj 'elevation))) ;;LWPolylines Polylines and 2DPolylines
                  (t
                    (setq p_lst (rh:sammlung_n (vlax-get pl_obj 'coordinates) 3)
                          elev (caddr (car p_lst))
                    );end_setq
                  )
            );end_cond

            (setq elev (+ elev 2)) ;edited line
            (cond
                  ;( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ;edited line
                  ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev))))))
                  (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev)))))
            );end_cond

            (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt))
            (vlax-put-property pl_obj 'layer lyr_txt)
          );end_repeat
        )
  );end_cond

  (setvar 'clayer clyr)
  (princ)
);end_defun

 

==================================================================================================

or you want custom range

(defun rh:sammlung_n (o_lst grp / tmp n_lst)
  (setq n_lst nil)
  (cond ( (and o_lst (= (rem (length o_lst) grp) 0))
          (while o_lst
            (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst)))
            (setq n_lst (cons (reverse tmp) n_lst) tmp nil)
          );end_while
        )
  );end_cond
  (if n_lst (reverse n_lst))
);end_defun

(vl-load-com)

(defun c:layerElev ( / c_doc c_lyrs ss clyr cnt pl_obj p_lst elev lyr_txt)
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
        clyr (getvar 'clayer)
  );end_setq

  (prompt "\nSelect Polylines : ")
  (setq ss (ssget '((0 . "*POLYLINE"))))

  (cond (ss
          (repeat (setq cnt (sslength ss))
            (setq pl_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))

            (cond 
                  ( (vlax-property-available-p pl_obj 'elevation) (setq elev (vlax-get pl_obj 'elevation))) ;;LWPolylines Polylines and 2DPolylines
                  (t
                    (setq p_lst (rh:sammlung_n (vlax-get pl_obj 'coordinates) 3)
                          elev (caddr (car p_lst))
                    );end_setq
                  )
            );end_cond

            (setq elev (ex:upsidefilter elev 20)) ;edited line
            (cond
                  ;( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ;edited line
                  ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev))))))
                  (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev)))))
            );end_cond

            (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt))
            (vlax-put-property pl_obj 'layer lyr_txt)
          );end_repeat
        )
  );end_cond

  (setvar 'clayer clyr)
  (princ)
);end_defun



(defun ex:upsidefilter ( a b / d e )
  (setq d (rem a b)) ; divide by b, remain
  (setq e (/ (- a d) b)) ; divide by b, result without remain
  (if (/= d 0)
    (progn
      (cond
        ((> a 0) (setq e (+ e 1)))
        ((> a (* b -1)) (setq e 0))
      )
    )
  )
  (* e b) ; range filtered value
)

 

you can adjust range set by 

(setq elev (ex:upsidefilter elev 20)) 

edit this "20"

Edited by exceed
  • Thanks 1

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