Sort contours

[Lee Mac]

hi..guys..good day..the lisp was post above it was very useful..and i appreciate that..one thing i need the lisp for computing the volume.

Oliver

 

Another wasted effort can be found here, it might be useful for you.

[Lee Mac]

With Lee's routine, the color of the contours change (to dark gray). The contours always seem to come in from the GIS software as all black. The change in color is nice because it is a visual confirmation something happened.

 

FYI There is nothing in my code to affect the colours, this just depends on the colours you have used for those particular layers.

[oliver]

compute the volume which is came or base from the contour lines.

[alanjt]

alanjt,

I have to apologize. I tried your routine several times and it would not load. I went back and checked it, when I copied and pasted it, a bit from the end was cut off. I fixed it and re-ran it, everything works perfectly. A couple of comments. I like the idea of selecting the objects. With Lee's routine, the color of the contours change (to dark gray). The contours always seem to come in from the GIS software as all black. The change in color is nice because it is a visual confirmation something happened. Want would be better.... if the major and minor layers were different colors. Like topo-major is dark gray ( and topo-minor is light gray (9). Then it would be easier to read and is closer to how it is actually used. Thanks very much. You guys are amazing.

 

Thanks for verifying. I was sure there wasn't an error.

 

A quick change... (choose the colors you like, I just used my choice).

 

(defun c:ContourLabel (/ l1 l2 ss)
 ((lambda (layers)
    (mapcar
      (function (lambda (var lay col)
                  (vla-put-color (set var (vla-add layers lay)) col)
                  (set var (vla-get-name var))
                )
      )
      '(l1 l2)
      '("V-TOPO-MAJR" "V-TOPO-MINR")
      '(243 253)
    )
  )
   (vla-get-layers
     (cond (*AcadDoc*)
           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
     )
   )
 )
 (if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (progn (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
            (vla-put-layer
              x
              (if (zerop (rem (caddr (vlax-curve-getEndPoint x)) 5.))
                l1
                l2
              )
            )
          )
          (vla-delete ss)
   )
 )
 (princ)
)

[marsspyder]

Since you're from PA and I've got close ties to Mars (Mars, PA that is), try this

No error control and the layer needs to be in the dwg

 

 

Thanks lpseifert. I'm currently paying rent for a place in Monroeville so hi quasi-neighbor!

 

I'm not sure your routine is doing what I'm trying to do. The program I use sorts to generate the contours sorts them into major and minor contours by 1.25 intervals (default and somewhat weird with .25 intervals, can't change it though) I'm trying to sort these further into individual layers, eg elev -5.25 contours all into layer "-5.25"

 

Can you help me out again? Or point me to a good source for learning to write routines?

 

Thanks again

[Lee Mac]

Or point me to a good source for learning to write routines?

 

http://www.cadtutor.net/forum/showthread.php?49515-Useful-LISP-Links

 

[marsspyder]

This is my first attempt at a routine and I need some guidance...

 

the tutorials tell me to write out what i need in English, so:

 

(name ()

(select group of polylines)

(if (z coord= a)

(move objects to layer "a")

(z coord =b)

(move objects to layer "b")

(z coord=etc etc etc)

(move objects to layer "etc etc etc")

)

)

 

This is where how far I've gotten. Can someone tell me if I'm heading the right way?

 

(defun C:plnlyr ()
(alert "This routine sorts polylines into layers by elevation");alert
 (setvar "cmdecho" 0);set variable cmdecho
(cond (member (rem (fix (caddr (vlax-curve-getEndPoint i))) 10) '(0 .25))
             (vla-put-layer i ".25")
        (member (rem (fix (caddr (vlax-curve-getEndPoint i))) 10) '(0 .5))
             (vla-put-layer i ".5")

 

Thanks everybody

[oliver]

This is my first attempt at a routine and I need some guidance...

 

the tutorials tell me to write out what i need in English, so:

 

(name ()

(select group of polylines)

(if (z coord= a)

(move objects to layer "a")

(z coord =b)

(move objects to layer "b")

(z coord=etc etc etc)

(move objects to layer "etc etc etc")

)

)

 

This is where how far I've gotten. Can someone tell me if I'm heading the right way?

 

(defun C:plnlyr ()
(alert "This routine sorts polylines into layers by elevation");alert
(setvar "cmdecho" 0);set variable cmdecho
(cond (member (rem (fix (caddr (vlax-curve-getEndPoint i))) 10) '(0 .25))
(vla-put-layer i ".25")
(member (rem (fix (caddr (vlax-curve-getEndPoint i))) 10) '(0 .5))
(vla-put-layer i ".5")

 

Thanks everybody

 

Sort contours2.lsp successfully loaded.

Command: ; error: misplaced dot on input

Command:

[Lee Mac]

.25

 

is not a valid number - better:

 

0.25

[djohnson.nz]

On 27/10/2010 at 12:48, Lee Mac said:

I want to play too

 

Completely untested of course...

 

 

(defun c:elevl ( / i ss e l1 l2 ) (vl-load-com)

 ( (lambda ( layers ) (mapcar '(lambda ( l ) (vla-Add layers l)) (mapcar 'set '(l1 l2) '("V-TOPO-MJR" "V-TOPO-MNR"))))
   (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
 )  

 (if (setq i -1 ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
   
   (while (setq e (ssname ss (setq i (1+ i))))
     
     ( (lambda ( layer ) (entmod (subst (cons 8 layer) (assoc 8 (entget e)) (entget e))))
       (if (member (rem (fix (caddr (vlax-curve-getEndPoint e))) 10) '(0 5)) l1 l2)
     )
   )
 )

 (princ)
)

 

 

Sorry to join so late.

I have used your script to create layers for 10, 5, 2 and 1m contours but am having trouble getting it to select 0.5 Contours.

Can you assist please

[BIGAL]

Have a look at FIX this is integer of endpoint try removing, 

 

(if (member (rem (caddr (vlax-curve-getEndPoint e)) 10) '(0 5)) l1 l2)

[KraZeyMike]

On 27/10/2010 at 10:48, Lee Mac said:

I want to play too

 

Completely untested of course...

 

 

(defun c:elevl ( / i ss e l1 l2 ) (vl-load-com)

 ( (lambda ( layers ) (mapcar '(lambda ( l ) (vla-Add layers l)) (mapcar 'set '(l1 l2) '("V-TOPO-MJR" "V-TOPO-MNR"))))
   (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)))
 )  

 (if (setq i -1 ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
   
   (while (setq e (ssname ss (setq i (1+ i))))
     
     ( (lambda ( layer ) (entmod (subst (cons 8 layer) (assoc 8 (entget e)) (entget e))))
       (if (member (rem (fix (caddr (vlax-curve-getEndPoint e))) 10) '(0 5)) l1 l2)
     )
   )
 )

 (princ)
)

 

 

 

Awesome Routine thankyou, I modified the selection set to:

(if (setq i -1 ss (ssget "_X" '((8 . "*Contours*")
              (0 . "ARC,LINE,*POLYLINE")
             )
         )
  )

 

I would like to change the Major contours to every whole number. for example 385.00
Rather than the (vlax-curve-getEndPoint e))) 10) '(0 5)) l1 l2).

Can I assign L1 to every 1m Elevation and L2 to every thing else?

Edited May 28 by KraZeyMike

[troggarf]

I don't know if this will address your issue.

I use it when I get exploded surfaces (polyline with elevation) and want to sort them...

;;; https://www.cadtutor.net/forum/topic/38534-filter-polyline-selection-by-z-value/page/2/
;;; Set Contour Labels to Layer
;;; By many people pBe, Chulse, Lee Mac, David Bethel

(defun C:SCL (/ *error* msg ELEV SS LAY2 LAY10 DOC UFLAG ALL obj temp s1 en)
 
 ;layer name used for 10' contours
 (setq lay10 "CE-DES-CONT-MAJR-EX")
 
 ;layer name used for 2' contours
 (setq lay2 "CE-DES-CONT-MINR-EX")
 
   (vl-load-com)
 (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))

 ;; --{  Error Handler Function by Lee Mac }--
 (defun *error* (msg)     
   (and uflag (vla-EndUndoMark doc))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")        
       (princ (strcat "\n** Error: " msg " **")))    
   (princ))  

 ;; --{  Main Function  }-- 
 (setq uflag (not (vla-StartUndoMark doc)))
 
 ;;; CHECK FOR LAYER AND ADD IF NOT EXIST
           (or (tblsearch "LAYER" LAY10)
           (vla-add (vla-get-layers doc) LAY10))
           
           (or (tblsearch "LAYER" LAY2)
           (vla-add (vla-get-layers doc) LAY2))
           
   ;put all obj on 2' contour layer        
  (setq all (ssget "_X" '((0 . "LWPOLYLINE") )))         
           
;;;            (foreach obj all
;;;            (vla-put-layer (vlax-ename->vla-object obj) LAY2)
;;;            );_end foreach
   (command "_.CHPROP" all "" "_LA" lay2 "")
   
;(find all contours from 10 to 10000 by 10)
   
 ; (setq elev 10 ss (ssadd))
 ; (while 
 ; (<= elev 10000);max elevation searched for is 10,000 feet - change if need be
   ; (if (setq temp (ssget "_X" (List '(0 . "LWPOLYLINE") (cons 38 elev))))
; (repeat (setq i (sslength temp))
     ; (ssadd  (ssname temp (setq i (1- i))) ss)))
        ; (setq elev (+ elev 10))
 ; );_end while
 
   (setq s1 (ssadd))
 (and (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
      (while (setq en (ssname ss 0))
             (if (zerop (rem (cdr (assoc 38 (entget en))) 5));;;<<---Changed 10 to 5
                 (ssadd en s1))
             (ssdel en ss)))
       ;;;s1)
 
 ;put 10' contours on correct new layer
;;;            (foreach obj S1
;;;            (vla-put-layer obj Lay10)
;;;            );_end foreach
    (command "_.CHPROP" s1 "" "_LA" lay10 "")
   
   ;clear ss
   (setq s1 nil)
    (setq all nil)   
 (setq uFlag (vla-EndUndoMark doc))
 (princ)
 );_end defun

 

[KraZeyMike]

I gave it a try this morning and after changing only the Contour Major and Minor layer names got the errors

Command: SCL
Unknown command "SCL".  Press F1 for help.
Command: _.CHPROP
Select objects:
The object is not in current space.        (All my Contours were in model space which is where the command was activated)
The object is not in current space.
2 found
2 were not in current space.
Select objects:
Command: _LA Unknown command "LA".  Press F1 for help.
Command: Contour-Major Unknown command "CONTOUR-MAJOR".  Press F1 for help.   

 

 

Ideally it would be great to add your elevation parameter into Lee's routine

 

What would be really cool (if possible) is a modification of Lee's routine whereby we could be prompted to enter the major interval.

Edited May 29 by KraZeyMike

[KraZeyMike]

Update: 

From Ipseifrt on Page 1 seems to be doing a good job so far.

 

A mod of Lee's Routine would be the greatest though. Beyond my limited ability unfortunately

Edited June 5 by KraZeyMike

[KraZeyMike]

(defun C:SCL (/ *error* msg ELEV SS LAY2 LAY1 DOC UFLAG ALL obj temp s1 en)
 
 ;layer name used for major contours
 (setq lay1 "Contour-Major")
 
 ;layer name used for minor contours
 (setq lay2 "Contour-Minor")
 
   (vl-load-com)
 (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))

 ;; --{  Error Handler Function by Lee Mac }--
 (defun *error* (msg)     
   (and uflag (vla-EndUndoMark doc))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")        
       (princ (strcat "\n** Error: " msg " **")))    
   (princ))  

 ;; --{  Main Function  }-- 
 (setq uflag (not (vla-StartUndoMark doc)))
 
 ;;; CHECK FOR LAYER AND ADD IF NOT EXIST
           (or (tblsearch "LAYER" LAY1)
           (vla-add (vla-get-layers doc) LAY1))
           
           (or (tblsearch "LAYER" LAY2)
           (vla-add (vla-get-layers doc) LAY2))
           
   ;put all obj on 2' contour layer        
  (setq all (ssget "_X" '((0 . "LWPOLYLINE") )))         
           
;;;            (foreach obj all
;;;            (vla-put-layer (vlax-ename->vla-object obj) LAY2)
;;;            );_end foreach
   (command "_.CHPROP" all "" "_LA" lay2 "")
   
;(find all contours from 1 to 10000 by 1)
   
 ; (setq elev 1 ss (ssadd))
 ; (while 
 ; (<= elev 10000);max elevation searched for is 10,000m - change if need be
   ; (if (setq temp (ssget "_X" (List '(0 . "LWPOLYLINE") (cons 38 elev))))
; (repeat (setq i (sslength temp))
     ; (ssadd  (ssname temp (setq i (1- i))) ss)))
        ; (setq elev (+ elev 1))
 ; );_end while
 
   (setq s1 (ssadd))
 (and (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
      (while (setq en (ssname ss 0))
             (if (zerop (rem (cdr (assoc 38 (entget en))) 1))
                 (ssadd en s1))
             (ssdel en ss)))
       ;;;s1)
 
 ;put 1 contours on correct new layer
;;;            (foreach obj S1
;;;            (vla-put-layer obj lay1)
;;;            );_end foreach
    (command "_.CHPROP" s1 "" "_LA" lay1 "")
   
   ;clear ss
   (setq s1 nil)
    (setq all nil)   
 (setq uFlag (vla-EndUndoMark doc))
 (princ)
 );_end defun

 

 

Going back to Troggarf's post I can get this to work but only for "Light" Polylines and only in Paper Space? Not sure why but the contours I am trying to sort by elevation are in model space and are 2dpolylines. I just can't quite find out where I'm editing this wrong. I tried changing ssget lwpolylines to *Polyline etc and a few other things to no avail.

Ideally was trying to use

(if (setq i -1 ss (ssget "_X" '((8 . "*Contours*")
              (0 . "ARC,LINE,*POLYLINE")
             )
         )
  )
Model space only converts everything to a minor contour and I'm not quite sure why some of this code has the semi colin prefixed to it which I always thought was only for comments?

Edited July 29 by KraZeyMike