Jump to content
Noklu

Sort contours

Recommended Posts

Noklu

I am looking for a routine to sort contour lines. I am using 3d polylines that I import from Global Mapper. My problem is all of the lines are on one layer. Ideally, I would like to pick a starting elevation (polyline) and have the routine select every 5th contour up and down. Once then are all selected, I can move them to a new layer (like TOPO-INDEX). Some of these sites are hundreds of acres and have significant elevation changes. To do this by hand is VERY time-consuming (and easy to miss some contours). I am not a programmer, but this seems like the type of task that is ideal for a lisp routine. Any help is appreciated.

Share this post


Link to post
Share on other sites
pBe

(Defun c:elevl (/ i)
 (vlax-for i (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
   (if (member (vla-get-ObjectName i)
'("AcDbLine" "AcDbArc" "AcDbPolyline" "AcDbLWPolyline" "AcDb2dPolyline"))
     (if (member (rem (fix (caddr (vlax-curve-getEndPoint i))) 10) '(0 5))
      (vla-put-layer i "V-TOPO-MJR")
      (vla-put-layer i "V-TOPO-MNR")  
     )
   )
 )
)

 

This is a good starting point

 

With credit to T.Willey and Pkohut @ theswamp.org

Share this post


Link to post
Share on other sites
jvillarreal

To get it to work for your 3d polylines, the object name list will have to include "AcDb3dPolyline"...and to extract the elevation: just look up vla-get-coordinates, vlax-variant-value, and vlax-safearray->list.

 

*EDIT*

Almost forgot, you'll need to include (vl-load-com) before (vlax-for...

Share this post


Link to post
Share on other sites
pBe
To get it to work for your 3d polylines, the object name list will have to include "AcDb3dPolyline"...and to extract the elevation: just look up vla-get-coordinates, vlax-variant-value, and vlax-safearray->list.

 

 

Thats right JV :) I played around with this code before to suit my needs... you need to do a lot of tweaking for this to work on your dwg, your needs is too specific

Share this post


Link to post
Share on other sites
Noklu

pBe, I can't get this to work.

Share this post


Link to post
Share on other sites
lpseifert

Are the contours actually 3DPolylines or are the polylines with an elevation?

Share this post


Link to post
Share on other sites
jvillarreal
(defun c:elevl (/ i layerlist)
(vl-load-com)
(foreach x (Setq layerlist '("V-TOPO-MJR" "V-TOPO-MNR"))
(entmake
(list    '(0 . "LAYER")
                             '(100 . "AcDbSymbolTableRecord")
                             '(100 . "AcDbLayerTableRecord")
                             (cons 2 x)
                             (cons 62 7)
                             '(70 . 0)
)
)
)
(vlax-for i (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-Acad-Object)))
 (if (member (vla-get-objectname i) '("AcDb3dPolyline"))
   (if
     (member
       (rem
         (fix 
           (caddr
             (vlax-safearray->list
               (vlax-variant-value
                 (vla-get-coordinates i)
               )
             )
           )
         ) 
       10
       )
     '(0 5)
     )
     (vla-put-layer i (car layerlist))
     (vla-put-layer i (cadr layerlist))
   )
 )
 (if (member (vla-get-ObjectName i) '("AcDbLine" "AcDbArc" "AcDbPolyline" "AcDbLWPolyline" "AcDb2dPolyline"))
   (if (member (rem (fix (caddr (vlax-curve-getEndPoint i))) 10) '(0 5))
     (vla-put-layer i (car layerlist))
     (vla-put-layer i (cadr layerlist))  
   )
 )
)
)

Share this post


Link to post
Share on other sites
Lee Mac

I want to play too :D

 

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

Edited by Lee Mac

Share this post


Link to post
Share on other sites
jvillarreal

Nice routine as usual Lee 8)

Share this post


Link to post
Share on other sites
pBe
pBe, I can't get this to work.

 

Try Lee's code, if you notice this line

(setq i -1 ss (ssget "_X" '((0 . "ARC,LINE[color=sienna],*POLYLINE[/color]"))))

it selects every type polyline you mght have.... and also lines and arcs...

 

you might want to add a prompt for the "range" of elevation to look for.. there are cases were 3dpolylines created with varying z coordinates... though it will be process, it might not give you the result you want.

just some of the things to think about on what you want for the end result.

:)

Share this post


Link to post
Share on other sites
eldon
there are cases where 3dpolylines created with varying z coordinates.

 

Then they would not be contours. :shock: Contours by definition are at a constant z value, and this thread is about contours.

Share this post


Link to post
Share on other sites
pBe
Then they would not be contours. :shock: Contours by definition are at a constant z value, and this thread is about contours.

 

Riiiiggghhhhhtttt..... what i meant is if by chance the existing drawing includes such entities , then it should be ignored by the routine, otherwise create a sub to deal with it.

Good point though :)

Share this post


Link to post
Share on other sites
Lee Mac
Nice routine as usual Lee 8)

 

Thanks mate, yours isn't bad either :)

Share this post


Link to post
Share on other sites
alanjt
(defun c:ContourLabel (/ l1 l2 ss)
 ((lambda (layers)
    (mapcar (function (lambda (var lay) (set var (vla-get-name (vla-add layers lay)))))
            '(l1 l2)
            '("V-TOPO-MAJR" "V-TOPO-MINR")
    )
  )
   (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)
)

Share this post


Link to post
Share on other sites
Noklu

I am overwhelmed! Thank you to everyone. I am able to get Lee Mac's and pBe's to work. I'm having a little trouble with alanjt's.

This is a big time saver!

Share this post


Link to post
Share on other sites
alanjt

Out of curiosity, what problem are you having with mine? I tested it after writing and it worked fine.

Share this post


Link to post
Share on other sites
marsspyder

Similar to this, is it possible to further sort (polyline) contours into smaller increments? Ex: I need to sort contours ranging from -7 to 4 into .25 increments. I have been sorting them by hand thus far, but after about the 53rd acre, it's getting a little old.

 

If anyone could help me with a lisp, I would be eternaly grateful

Share this post


Link to post
Share on other sites
Noklu

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 (8) 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.

Edited by Noklu

Share this post


Link to post
Share on other sites
lpseifert
Similar to this, is it possible to further sort (polyline) contours into smaller increments? Ex: I need to sort contours ranging from -7 to 4 into .25 increments. I have been sorting them by hand thus far, but after about the 53rd acre, it's getting a little old.

 

If anyone could help me with a lisp, I would be eternaly grateful

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

(defun c:test ()
 (vl-load-com)
(setq bas (getreal "Enter base elevation: ")
     ci5 (* 5 (getreal "Enter contour interval: "));every 5th contour indexed
      ss (ssget '((0 . "*polyline")))
      idx -1
     )
(repeat (sslength ss)
  (setq obj (vlax-ename->vla-object (ssname ss (setq idx (1+ idx)))))
 (if
   (zerop (rem (vlax-get obj 'Elevation) ci5))
   (vlax-put obj 'Layer "CONT-IDX");change layer name to suit
   )
 )
(princ)
 )

Share this post


Link to post
Share on other sites
oliver

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

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

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