classify layer accoding to height using visual basic

[mien]

can someone teach me how to class the layer according to height range using visual basic or lips..thanks..

[Lee Mac]

Do you mean look at every object on each layer and get a range of the z-coord for the objects, then ranking the layers in order of height?

 

Or am I way off the mark

[mien]

select the object on the screen then classify the z-coordinates according to the height range.for example height 20-30 is layer 1 and 31-40 is layer 2

[Lee Mac]

What about those with height 30.5?

[Lee Mac]

Hows this for starters...

 

(defun c:htchng (/ olderr *error* vLst oldvars ss i z)
 (vl-load-com)
 (setq olderr *error* *error* errtrap)
 (defun errtrap (msg)
   (if oldvars (mapcar 'setvar vLst oldvars)) (setq *error* olderr)
   (princ (strcat "\nError: " (strcase msg))) (princ))
 (setq vLst (list "CMDECHO" "CLAYER") oldvars (mapcar 'getvar vLst))
 (if (setq ss (ssget (list (if (getvar "CTAB")
    (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (mapcar 'makelay '("20-30" "31-40"))
     (setq ss (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) i 0)
     (foreach e ss
   (setq z (cadddr (assoc 10 e)))
   (cond ((<= 20 z 30)
          (entmod (subst (cons 8 "20-30") (assoc 8 e) e)))
         ((<= 31 z 40)
          (entmod (subst (cons 8 "31-40") (assoc 8 e) e)))
         (T (setq i (1+ i)))))
     (princ (strcat "\n" (rtos i) " Objects were outside of Height Range.")))
   (princ "\n<!> No Objects Selected <!>"))
 (mapcar 'setvar vLst oldvars)
 (princ))

(defun makelay (lay)
 (if (not (tblsearch "LAYER" lay))
   (progn (setvar "CMDECHO" 0)
     (command "-layer" "M" lay ""))))

 

Should get you started

[mien]

its include all value in that range....thanks Lee Mark

[Lee Mac]

This is better:

 

(defun c:htchng (/ olderr *error* vLst oldvars ss i z)
 (vl-load-com)
 (setq olderr *error* *error* errtrap)
 (defun errtrap (msg)
   (if oldvars (mapcar 'setvar vLst oldvars)) (setq *error* olderr)
   (princ (strcat "\nError: " (strcase msg))) (princ))
 (setq vLst (list "CMDECHO" "CLAYER") oldvars (mapcar 'getvar vLst))
 (if (setq ss (ssget (list (if (getvar "CTAB")
    (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (mapcar 'makelay '("20-30" "31-40"))
     (setq ss (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) i 0)
     (foreach e ss
   (setq z (cadddr (assoc 10 e)))
   (cond ((and (<= 20 z) (< z 31))
          (entmod (subst (cons 8 "20-30") (assoc 8 e) e)))
         ((and (<= 31 z) (< z 41))
          (entmod (subst (cons 8 "31-40") (assoc 8 e) e)))
         (T (setq i (1+ i)))))
     (princ (strcat "\n" (rtos i) " Objects were outside of Height Range.")))
   (princ "\n<!> No Objects Selected <!>"))
 (mapcar 'setvar vLst oldvars)
 (princ))

(defun makelay (lay)
 (if (not (tblsearch "LAYER" lay))
   (progn (setvar "CMDECHO" 0)
     (command "-layer" "M" lay ""))))

[mien]

dear Lee Mark..can we find min and max height than we can decide how many contour interval we want, which mean the range is variable..

[eldon]

dear Lee Mark..can we find min and max height than we can decide how many contour interval we want, which mean the range is variable..

 

This looks like the thin end of the wedge. Mien, you are presuming on Lee Mac's good nature.

The next thing you will want him to write is a full blown ground model package.

[Lee Mac]

I know what you mean Eldon... only just posted the first and he requests a second...

 

But, its all good practice.

[Lee Mac]

Ok, Mien - try this:

 

(defun c:htchng (/ olderr *error* vLst oldvars ss eLst zs int ma mi intsz cnt lnmlst z)
 (vl-load-com)
 (setq olderr *error* *error* errtrap)
 (defun errtrap (msg)
   (if oldvars (mapcar 'setvar vLst oldvars)) (setq *error* olderr)
   (princ (strcat "\nError: " (strcase msg))) (princ))
 (setq vLst (list "CMDECHO" "CLAYER") oldvars (mapcar 'getvar vLst))
 (if (setq ss (ssget (list (if (getvar "CTAB")
    (cons 410 (getvar "CTAB")) (cons 67 (- 1 (getvar "TILEMODE")))))))
   (progn
     (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       eLst (mapcar 'entget ss)
       zs (mapcar '(lambda (x) (cadddr (assoc 10 x))) eLst))
     (initget 7)
     (setq int (getint (strcat "\nMax Height: " (rtos (setq ma (apply 'max zs))) (chr 44)
               " Min Height: " (rtos (setq mi (apply 'min zs))) ", How Many Intervals?  ")))
     (setq intsz (/ (- ma mi) int))
     (princ (strcat "\nInterval Size: " (rtos intsz))) (setq cnt 0)
     (while (<= cnt int) (setq lnm (strcat (rtos (+ mi (* cnt intsz))) (chr 45) (rtos (+ mi (* intsz (1+ cnt))))))
   (setq lnmlst (cons lnm lnmlst)) (setq cnt (1+ cnt)))
     (mapcar 'makelay lnmlst)
     (setq lnmlst (reverse lnmlst) cnt 0)
     (foreach e eLst
       (setq z (cadddr (assoc 10 e)))
   (foreach l lnmlst
     (if (and (<= (+ mi (* cnt intsz)) z) (< z (+ mi (* intsz (1+ cnt)))))
       (entmod (subst (cons 8 l) (assoc 8 e) e)))
     (setq cnt (1+ cnt)))
   (setq cnt 0)))
   (princ "\n<!> No Objects Selected <!>"))
 (mapcar 'setvar vLst oldvars)
 (princ))

(defun makelay (lay)
 (if (not (tblsearch "LAYER" lay))
   (progn (setvar "CMDECHO" 0)
     (command "-layer" "M" lay ""))))

[mien]

i'm sorry Lee Mac and eldon...i must study the lisp provided by Lee Mac to understand the program. i trying to create my own lips.

[Lee Mac]

No worries Mien, - I'm happy to help

 

Does the LISP perform as required?