Jump to content

Recommended Posts

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.

Link to post
Share on other sites
  • Replies 30
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    6

  • Noklu

    4

  • pBe

    4

  • jvillarreal

    3

(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

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

Link to post
Share on other sites
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

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

Link to post
Share on other sites

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
Link to post
Share on other sites
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.

:)

Link to post
Share on other sites
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.

Link to post
Share on other sites
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 :)

Link to post
Share on other sites
(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)
)

Link to post
Share on other sites
  • 2 weeks later...

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!

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

Link to post
Share on other sites

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
Link to post
Share on other sites
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)
 )

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