Jump to content

classify layer accoding to height using visual basic


mien

Recommended Posts

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

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