Colour a Point Cloud by Elevation Sections

Hey Everyone,

I am using Autocad 2002-2011.

I have a large point cloud usually around 100,000 points maybe more, unfortunatly the only way the program will send these points to autocad is in plain white.

I was just wondering before I tried to make some lisp if anyone has a lisp that will colour a point cloud by its elevation.

By colour I mean a range of colours so I can see the difference in elevation when viewing the points from an overhead view.

If not I intend to design something that works like gather all the points into an array then sort them based on the range from the highest point Z value to the lowest point Z value, assign colours to the divided percentage of elevation of the points i.e. red 0-10% blue 11-20% and so on.

Anywho, if anyone knows of a lisp out already that does something similar send me a shout!

Thanks,

Kablamtron

I do not have a routine for you, as I rarely work with point clouds, but you might try developing something that steps through a filtered selection set of your points, and checks for the point elevation using a cond statement, and then changes the point color accordingly using the vla-put-color function.

Edit:

However, if you want to sort the point elevations via the percentage brackets you've outlined, I believe that you might have to step through the selection set twice...

The first time to construct a grouped pair of elevation and vla-object in a sorted list, and to get a total count, the second pass to step through your sorted list, pulling the vla-object reference (cadr?) and applying the color.

Hope this helps!

You could create a dotted pair list (Elev . EName) to break up however you like and modify accordingly - I would just use entmod.

eg. (create dotted pair list)

(defun foo (/ ss)
 (if (setq ss (ssget "_X" '((0 . "POINT"))))
   ((lambda (i / e l)
      (while (setq e (ssname ss (setq i (1+ i))))
        (setq l (cons (cons (last (assoc 10 (entget e))) e) l))
      )
      (vl-sort l (function (lambda (a b) (< (car a) (car b)))))
    )
     -1
   )
 )
)

eg. (modify with determined color)

(defun foo (l c)
 (entupd (cdr (assoc -1
                     (entmod (if (assoc 62 l)
                               (subst (cons 62 c) (assoc 62 l) l)
                               (append l (list (cons 62 c)))
                             )
                     )
              )
         )
 )
)

(foo (entget ) 3)

I liked the percentage approach

color 1 = 0 - 10%

color 2 = 10.0001 - 20%

color 3 = 20.0001 - 30%

etc

[b][color=BLACK]([/color][/b]defun c:pelcl [b][color=FUCHSIA]([/color][/b]/ ss i en ed ev el minz delta pc nc[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]if [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"POINT"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]progn
        [b][color=MAROON]([/color][/b]setq i [b][color=GREEN]([/color][/b]sslength ss[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]setq en [b][color=BLUE]([/color][/b]ssname ss [b][color=RED]([/color][/b]setq i [b][color=PURPLE]([/color][/b]1- i[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]setq ed [b][color=BLUE]([/color][/b]entget en[b][color=BLUE])[/color][/b]
                     ev [b][color=BLUE]([/color][/b]caddr [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 10 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                     el [b][color=BLUE]([/color][/b]cons ev el[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]setq minz [b][color=GREEN]([/color][/b]apply 'min el[b][color=GREEN])[/color][/b]
             delta [b][color=GREEN]([/color][/b]- [b][color=BLUE]([/color][/b]apply 'max el[b][color=BLUE])[/color][/b] [b][color=BLUE]([/color][/b]apply 'min el[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                  i -1[b][color=MAROON])[/color][/b]
        [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]setq en [b][color=BLUE]([/color][/b]ssname ss [b][color=RED]([/color][/b]setq i [b][color=PURPLE]([/color][/b]1+ i[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]setq ed [b][color=BLUE]([/color][/b]entget en[b][color=BLUE])[/color][/b]
                     ev [b][color=BLUE]([/color][/b]caddr [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 10 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                     pc [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 62 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                     nc [b][color=BLUE]([/color][/b]- 10 [b][color=RED]([/color][/b]abs [b][color=PURPLE]([/color][/b]fix [b][color=TEAL]([/color][/b]/ [b][color=OLIVE]([/color][/b]- delta [b][color=GRAY]([/color][/b]- ev minz[b][color=GRAY])[/color][/b] 1e-4[b][color=OLIVE])[/color][/b] delta 0.1[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                     ed [b][color=BLUE]([/color][/b]if pc [b][color=RED]([/color][/b]subst [b][color=PURPLE]([/color][/b]cons 62 nc[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]cons 62 pc[b][color=PURPLE])[/color][/b] ed[b][color=RED])[/color][/b]
                               [b][color=RED]([/color][/b]append ed [b][color=PURPLE]([/color][/b]list [b][color=TEAL]([/color][/b]cons 62 nc[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
               [b][color=GREEN]([/color][/b]entmod ed[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

Colors 1 + 10 are fairly close on my setup, but I can still differentiate. Good luck! -David

As a wise man once said...

So much for teaching.

lol

Edit: BTW, great routines guys!

Wow haha,

Well I was going to write the routine lol but man you guys are fast!

I tried it out david and it works perfectly.

Thanks alan for your input too and david for writing such a great lisp.

Thanks again guys!

Kablamtron

You're welcome.

I will find a variation of this useful in my work

Here's 1 a little more compact:

[b][color=BLACK]([/color][/b]defun c:pelcl [b][color=FUCHSIA]([/color][/b]/ ss i en ed ev el minz delta pc nc[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]and [b][color=NAVY]([/color][/b]setq i -1 ss [b][color=MAROON]([/color][/b]ssget [color=#2f4f4f]"X"[/color] '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"POINT"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]1+ i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   el [b][color=GREEN]([/color][/b]cons [b][color=BLUE]([/color][/b]caddr [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 10 ed[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b] el[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]setq minz [b][color=MAROON]([/color][/b]apply 'min el[b][color=MAROON])[/color][/b]
           delta [b][color=MAROON]([/color][/b]- [b][color=GREEN]([/color][/b]apply 'max el[b][color=GREEN])[/color][/b] minz[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq en [b][color=GREEN]([/color][/b]ssname ss [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]1- i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq ed [b][color=GREEN]([/color][/b]entget en[b][color=GREEN])[/color][/b]
                   ev [b][color=GREEN]([/color][/b]caddr [b][color=BLUE]([/color][/b]cdr [b][color=RED]([/color][/b]assoc 10 ed[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   pc [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 62 ed[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   nc [b][color=GREEN]([/color][/b]- 10 [b][color=BLUE]([/color][/b]abs [b][color=RED]([/color][/b]fix [b][color=PURPLE]([/color][/b]/ [b][color=TEAL]([/color][/b]- delta [b][color=OLIVE]([/color][/b]- ev minz[b][color=OLIVE])[/color][/b] 1e-4[b][color=TEAL])[/color][/b] delta 0.1[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                   ed [b][color=GREEN]([/color][/b]if pc [b][color=BLUE]([/color][/b]subst [b][color=RED]([/color][/b]cons 62 nc[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]cons 62 pc[b][color=RED])[/color][/b] ed[b][color=BLUE])[/color][/b]
                             [b][color=BLUE]([/color][/b]append ed [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]cons 62 nc[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entmod ed[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

-David

Thanks alan for your input too and david for writing such a great lisp.

Always happy to not help.

Hey Everyone,

I am looking at the output and the %bands it makes are a bit broad like

0-10% blue

10.005-20% red

I think I'm gonna try to change the lisp to rgb true colour the same principle as before but something more like:

r 0 g 255 b 0 0.1%-0.2%

r 1 g 255 b 0 0.2%-0.3% and so on, just go through the whole range of colours to be able to see the more subtle elevation changes.

I will post it when I'm done!

As usual thanks for the help

Kablamtron

Always happy to not help.

... and the OP just rolls on by , "ehh, look at that dead squirrel over there..."

"No _ _ _ _ _ _ _!"

Sorry it took so long guys I forgot to post it!

I was changing it again and remembered I said I was going to post the tighter colour bands.

david did all the work, all the credit goes to him!

;originally made by David Bethel
;modified by Kablamtron
(defun c:rgb (/ ss i en ed ev el minz delta pc nc)
 (if (setq ss (ssget "X" '((0 . "POINT"))))
     (progn
        (setq i (sslength ss))
        (while (setq en (ssname ss (setq i (1- i))))
               (setq ed (entget en)
                     ev (caddr (cdr (assoc 10 ed)))
                     el (cons ev el)))
        (setq minz (apply 'min el)
             delta (- (apply 'max el) (apply 'min el))
                  i -1)
        (while (setq en (ssname ss (setq i (1+ i))))
               (setq ed (entget en)
                     ev (caddr (cdr (assoc 10 ed)))
                     pc (cdr (assoc 62 ed))
                     nc (- 249 (abs (fix (*  24.9 (/ (- delta (- ev minz) 1e-4) delta 0.1)))))
                     ed (if pc (subst (cons 62 nc) (cons 62 pc) ed)
                               (append ed (list (cons 62 nc)))))
               (entmod ed))))
(prin1))

I sure can't get any of these ideas to work for me. Using DCA "Point" and acad 2008 vanilla

thanks in advance for clues

S

Hey Steve,

my modified lisp runs if you load it in then type rgb into the command line,

the orginal runs off a different command can't remember what it was.

What it does is select all autocad "points" and by points I mean if you type into the command line "point" and click, it will select what you made or if you have existing points in a drawing.

Make sure the points aren't in a block or it can't select them.

I am not sure what else could cause problems other than it not actually being an autocad point or the points are in an unexploded block.

Hope that helps!

Kablamtron

Hey Steve,

 

my modified lisp runs if you load it in then type rgb into the command line,

 

the orginal runs off a different command can't remember what it was.

 

What it does is select all autocad "points" and by points I mean if you type into the command line "point" and click, it will select what you made or if you have existing points in a drawing.

 

Make sure the points aren't in a block or it can't select them.

 

I am not sure what else could cause problems other than it not actually being an autocad point or the points are in an unexploded block.

 

Hope that helps!

 

Kablamtron

After the hints above, it works fine now. thanks S

Hey Steve,

 

my modified lisp runs if you load it in then type rgb into the command line,

 

the orginal runs off a different command can't remember what it was.

 

What it does is select all autocad "points" and by points I mean if you type into the command line "point" and click, it will select what you made or if you have existing points in a drawing.

 

Make sure the points aren't in a block or it can't select them.

 

I am not sure what else could cause problems other than it not actually being an autocad point or the points are in an unexploded block.

 

Hope that helps!

 

Kablamtron

Excellent work. Is it possible to improve the routine by creating different layers for each color group? Of course it would be great to be possible to create a legend to identify the different colors and their correspondence in the Z value, the example of what happens with the hypsometric scale.

Excellent work. Is it possible to improve the routine by creating different layers for each color group? Of course it would be great to be possible to create a legend to identify the different colors and their correspondence in the Z value, the example of what happens with the hypsometric scale.

Instead of adding layers into the mix (as each point is already on a layer), perhaps Lee's GrText routine will help yield the result you want.

Instead of adding layers into the mix (as each point is already on a layer), perhaps Lee's GrText routine will help yield the result you want.

I appreciate the suggestion. However, it is not what he wanted. When I refer to create layers, I want every elevation corresponds a separate layer.

By the way, add another challenge: To adopt the same concept of differentiation by color and layer, but applied to polylines in different values ​​Z. It would be excellent in works of topography.