Author Topic: Unique xy point list but ignore z  (Read 3646 times)

0 Members and 1 Guest are viewing this topic.

XXL66

  • Newt
  • Posts: 99
Unique xy point list but ignore z
« on: June 18, 2014, 10:32:54 AM »
hi,

i have a 3D point list and would like to remove the duplicates (with a fuzz for xy only) but it should ignore the z values doing this, however the return list should still have the z values included for the point.
 
thus points (1.0 2.0 2.1) and (1.0 2.01 3.0) or considered equal (xy with 0.01 fuzz) and the first should be returned in the list (1.0 2.0 2.1).

any ideas ? ty !



XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #1 on: June 18, 2014, 10:54:55 AM »
with help from LM ! ty LM !

but i'm wondering is there a inverse cdr function ? every item but the last ?  (reverse (cdr (reverse x))) ?

Code: [Select]
(defun LM:UniqueFuzzXY ( l f / x r )
    (while l
        (setq x (car l)
      x_ (list (car x) (cadr x))
              l (vl-remove-if (function (lambda ( y ) (equal x_ (list (car y) (cadr y)) f))) (cdr l))
              r (cons x r)
        )
    )
    (reverse r)
)

ymg

  • Swamp Rat
  • Posts: 725
Re: Unique xy point list but ignore z
« Reply #2 on: June 18, 2014, 11:16:47 AM »
Code: [Select]
(defun butLast (l) (reverse (cdr (reverse l))))

We call it butlast and it is exactly as you proposed.

ymg

LE3

  • Guest
Re: Unique xy point list but ignore z
« Reply #3 on: June 18, 2014, 11:22:04 AM »
^ yes, many of us (old ones or x-lispers) remember this place: http://autocad.xarch.at/news/faq/autolisp.html

Good times - indeed!.

ymg

  • Swamp Rat
  • Posts: 725
Re: Unique xy point list but ignore z
« Reply #4 on: June 18, 2014, 03:39:12 PM »
Quote
^ yes, many of us (old ones or x-lispers) remember this place: http://autocad.xarch.at/news/faq/autolisp.html

You must be my age, Luis.


ymg

LE3

  • Guest
Re: Unique xy point list but ignore z
« Reply #5 on: June 18, 2014, 04:10:24 PM »
Quote
^ yes, many of us (old ones or x-lispers) remember this place: http://autocad.xarch.at/news/faq/autolisp.html

You must be my age, Luis.


ymg

21? (hehe.... aha)... Have fun! (btw good code stuff you have posted lately)

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Unique xy point list but ignore z
« Reply #6 on: June 18, 2014, 07:06:48 PM »

roy_043

  • Water Moccasin
  • Posts: 1747
  • BricsCAD 18
Re: Unique xy point list but ignore z
« Reply #7 on: June 19, 2014, 03:55:41 AM »
Not very important but...
The variable x_ is not localized in LM:UniqueFuzzXY.

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #8 on: June 19, 2014, 04:18:46 AM »
yes, but that's my fault, not LM's !

BTW LM. I use another function from you that i use in a function to create a gradient color map on a tin (hsltorgb). The doslib version works fine, but yours gives me strange results...see attached picture.
Something seems to go wrong with the conversion.

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #9 on: June 19, 2014, 04:25:50 AM »
Not very important but...
The variable x_ is not localized in LM:UniqueFuzzXY.

Very important (from your site):

... Arkey (a Dutch CAD program) and BricsCAD (After chocolates, the next best Belgian export product).

 :wink:

roy_043

  • Water Moccasin
  • Posts: 1747
  • BricsCAD 18
Re: Unique xy point list but ignore z
« Reply #10 on: June 19, 2014, 08:14:02 AM »
Not very important but...
The variable x_ is not localized in LM:UniqueFuzzXY.

Very important (from your site):

... Arkey (a Dutch CAD program) and BricsCAD (After chocolates, the next best Belgian export product).

 :wink:
I agree with you that BricsCAD is a very good product. But let's not forget the excellent Belgian beers... :laugh:

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #11 on: June 19, 2014, 08:42:43 AM »
Yes, belgian beers, tell me about it, but you dutch made a major leap with La Trappe (quadrupel) ...

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Unique xy point list but ignore z
« Reply #12 on: June 19, 2014, 02:18:42 PM »
BTW LM. I use another function from you that i use in a function to create a gradient color map on a tin (hsltorgb). The doslib version works fine, but yours gives me strange results...see attached picture.
Something seems to go wrong with the conversion.

Note that the DOSLib function is dos_hlstorgb, whereas my function is LM:hsl->rgb... this may be causing some problems if the saturation & luminance arguments are supplied in the wrong order.

Here is an updated version of my code to make it more concise:
Code - Auto/Visual Lisp: [Select]
  1. ;; HSL -> RGB  -  Lee Mac
  2. ;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100
  3.  
  4. (defun LM:HSL->RGB ( h s l / u v )
  5.     (setq h (/ h 360.0)
  6.           s (/ s 100.0)
  7.           l (/ l 100.0)
  8.     )
  9.     (mapcar '(lambda ( x ) (fix (+ 0.5 (* 255 x))))
  10.         (cond
  11.             (   (zerop s) (list l l l))
  12.             (   (zerop l)'(0 0 0))
  13.             (   (setq v (if (< l 0.5) (* l (1+ s)) (- (+ l s) (* l s)))
  14.                       u (-  (* 2.0 l) v)
  15.                 )
  16.                 (mapcar
  17.                    '(lambda ( h )
  18.                         (setq h (rem (1+ h) 1))
  19.                         (cond
  20.                             (   (< (* 6.0 h) 1.0) (+ u (* 6.0 h (- v u))))
  21.                             (   (< (* 2.0 h) 1.0) v)
  22.                             (   (< (* 3.0 h) 2.0) (+ u (* 6.0 (- (/ 2.0 3.0) h) (- v u))))
  23.                             (   u   )
  24.                         )
  25.                     )
  26.                     (list (+ h (/ 1.0 3.0)) h (- h (/ 1.0 3.0)))
  27.                 )
  28.             )
  29.         )
  30.     )
  31. )

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #13 on: June 20, 2014, 03:28:38 AM »
Oops, really need to make an appointment with the ophthalmologist !

thx !

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Unique xy point list but ignore z
« Reply #14 on: June 21, 2014, 08:39:05 AM »
Oops, really need to make an appointment with the ophthalmologist !

No worries  :-)

Do the two functions now produce identical results?

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #15 on: June 21, 2014, 10:51:15 AM »
no, because i need the HLS, that is the input i get.
but no worries, the doslib version is fine.

But other suggestions for improvement are welcome.  :-)

Code: [Select]
;*****************************************************************************;
; Initiated by XXL at TheSwamp                                                ;
;                                                                             ;
; June 2014                                                                   ;
; c:gcmap draws a gradient color map on a TIN                                  ;
; DOSLIB needs to be loaded for 'dos_hlstorgb' function                       ;
;*****************************************************************************;

(defun c:gcmap (/       col_Hb  col_He  col_L   col_S   s       i
       zl      ent     ival    Hue_i   TinMaxZ    TinMinZ    sug_ival
       hue_i
      )

  (setq col_Hb 0)
  ;; color min hue value
  (setq col_He 240)
  ;; color max hue value
  (setq col_L 120)
  ;; color light
  (setq col_S 240)
  ;; color saturation

  ;; select 3DFACES
  (setq s (ssget '((0 . "3DFACE"))))

  ;; make a list from every elevation value in the TIN
  (repeat (setq i (sslength s))
    (setq ent (ssname s (setq i (1- i))))
    (setq
      zl (append
   (mapcar 'cadddr
   (mapcar '(lambda (key) (assoc key (entget ent)))
   '(11 12 13)
   )
   )
   zl
)
    )
  )

  (setq TinMaxZ (apply 'max zl)
;; min TIN elevation
TinMinZ (apply 'min zl)
        ;; max TIN elevation
  )

  ;; compute an interval suggestion for about 20 levels
  (setq sug_ival (/ (- TinMaxZ TinMinZ) 20.0))
  ;; round to mm level
  (setq sug_ival (/ (fix (+ 0.5 (* sug_ival 1000.0))) 1000.0))
 
 
  ;; computed suggestion is rounded
  (cond ((> sug_ival 1.0)
(setq sug_ival (fix sug_ival))
)
((< sug_ival 0.099)
(setq sug_ival (/ (fix (+ 0.5 (* 100.0 sug_ival))) 100.0))
)
((< sug_ival 0.999)
(setq sug_ival (/ (fix (+ 0.5 (* 10.0 sug_ival))) 10.0))
)
  )
 
  ;; get user interval input and verify
  (while (not ival)
    (setq ival
   (getreal
     (strcat
       "\nEnter interval (suggested: "
       (rtos sug_ival 2 3)
       "m): "
     )
   )
    )
    (cond
      ((not ival)
       (setq ival sug_ival)
      )
      (t
       (progn
(if (> (/ (- TinMaxZ TinMinZ) ival) (- col_He col_Hb))
   (progn
     (alert
       "\nEntered interval is too small for color range, please choose a larger interval."
     )
     (setq ival nil)
   )
)
       )
      )
    )
  )
  (prompt (strcat "\nComputing "
  (rtos (/ (- TinMaxZ TinMinZ) ival) 2 0)
  " elevation levels... "
  )
  )
 
  ;; compute Hue increment for each elevation level based on color hue range, TIN delta elevation and interval
  (setq Hue_i (fix (/ (- col_He col_Hb) (/ (- TinMaxZ TinMinZ) ival))))
 
  ;; process every 3DFACE entity from selectionset s
  (repeat (setq i (sslength s))
    (setq ent (ssname s (setq i (1- i))))
    (trfill ent)
  )

  ;;; generate legend
;;;  (while (not (setq pt (getpoint "\nSelect position legend: "))))
;;;  (setq dval (* ival (+ 1 (fix (/ TinMinZ ival)))))
;;;  (setq x  (car pt)
;;; x1 (+ (car pt) 4.0)
;;; y  (cadr pt)
;;; y1 (+ (cadr pt) 1.0)
;;;  )
;;;  (repeat (fix (/ (- TinMaxZ TinMinZ) ival))
;;;    (progn
;;;      (setq
;;; cl (rgbtotruecolor
;;;      (dos_hlstorgb
;;;        (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i)))
;;;        col_L
;;;        col_S
;;;        
;;;        
;;;      )
;;;    )
;;;      )
;;;      (entmake (list (cons 0 "SOLID")
;;;      (cons 8 "LEGEND")
;;;      (cons 420 cl)
;;;      (cons 10 (list x y))
;;;      (cons 11 (list x y1))
;;;      (cons 12 (list x1 y))
;;;      (cons 13 (list x1 y1))
;;;        )
;;;      )
;;;      (setq dval$ (strcat "SOLID_" (rtos dval 2 2)))
;;;      (setq dval (+ ival dval)
;;;     y y1
;;;     y1 (+ y1 1.0)
;;;      )
;;;    )
;;;  )
;;; need to finish this


 
  (princ "done.")
  (princ)
)


;; fill every 3DFACE with gradient colors
(defun trfill (e / pl pi1 pi2 pi3 i1 i2 i3 minz maxz dval dval$ cl)
  ;; create pointlist from 3Dface
  (setq
    pl (mapcar
'cdr
(mapcar '(lambda (key) (assoc key (entget e))) '(11 12 13))
       )
  )
  (setq pl (vl-sort pl
    (function (lambda (a b) (< (caddr a) (caddr b))))
   )
  )

  ;; min and max elevation of 3Dface
  (setq minz (caddr (car pl)))
  (setq maxz (caddr (car (reverse pl))))

  (setq dval (* ival (+ 1 (fix (/ minz ival)))))
  (setq dval$ (strcat "SOLID_" (rtos (- dval ival) 2 2)))
  (if (>= dval maxz)
;;; there will be no intersections, colour the entire 3DFACE with a single solid
    (progn
      (setq
cl (rgbtotruecolor
     (dos_hlstorgb
       (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i)))
       col_L
       col_S
       
     )
   )
      )
      (entmake (list (cons 0 "SOLID")
     (cons 8 dval$)
     (cons 420 cl)
     (cons 10 (nth 0 pl))
     (cons 11 (nth 1 pl))
     (cons 12 (nth 2 pl))
     (cons 13 (nth 2 pl))
       )
      )
    )
    (progn
      (while (< dval maxz)
(progn
  (setq
    cl (rgbtotruecolor
(dos_hlstorgb
   (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i)))
   col_L
   col_S
   
)
       )
  )
  (setq
    i2 (inters (nth 0 pl)
       (nth 1 pl)
       (list (car (nth 0 pl)) (cadr (nth 0 pl)) dval)
       (list (car (nth 1 pl)) (cadr (nth 1 pl)) dval)
       t
       )
  )
  (setq
    i1 (inters (nth 0 pl)
       (nth 2 pl)
       (list (car (nth 0 pl)) (cadr (nth 0 pl)) dval)
       (list (car (nth 2 pl)) (cadr (nth 2 pl)) dval)
       t
       )
  )
  (setq
    i3 (inters (nth 1 pl)
       (nth 2 pl)
       (list (car (nth 1 pl)) (cadr (nth 1 pl)) dval)
       (list (car (nth 2 pl)) (cadr (nth 2 pl)) dval)
       t
       )
  )
  (cond ((and i1 i2)
(if (and (not pi1) (not pi2))
   ;; no previous intersections on edges
   (entmake (list (cons 0 "SOLID")
  (cons 8 dval$)
  (cons 420 cl)
  (cons 10 (nth 0 pl))
  (cons 11 i1)
  (cons 12 i2)
  (cons 13 i2)
    )
   )
   (entmake (list (cons 0 "SOLID")
  (cons 8 dval$)
  (cons 420 cl)
  (cons 10 pi1)
  (cons 11 i1)
  (cons 12 pi2)
  (cons 13 i2)
    )
   )
)
(setq pi1 i1
       pi2 i2
)
)
((and i1 i3)
(if (and (not pi1) (not pi2))
   ;; no previous intersections on edges
   (entmake (list (cons 0 "SOLID")
  (cons 8 dval$)
  (cons 420 cl)
  (cons 10 (nth 0 pl))
  (cons 11 i1)
  (cons 12 (nth 1 pl))
  (cons 13 i3)
    )
   )
   (progn
     (entmake (list (cons 0 "SOLID")
    (cons 8 dval$)
    (cons 420 cl)
    (cons 10 pi1)
    (cons 11 i1)
    (cons 12 pi2)
    (cons 13 i3)
      )
     )
     (if (< (caddr pi1) (caddr (nth 1 pl)))
       (entmake (list (cons 0 "SOLID")
      (cons 8 dval$)
      (cons 420 cl)
      (cons 10 pi2)
      (cons 11 i3)
      (cons 12 (nth 1 pl))
      (cons 13 (nth 1 pl))
)
       )
     )

   )
)
(setq pi1 i1
       pi2 i3
)
)

  )
  (setq dval$ (strcat "SOLID_" (rtos dval 2 2)))
  (setq dval (+ ival dval))
  (setq
    cl (rgbtotruecolor
(dos_hlstorgb
  (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i)))
   col_L
   col_S
 
)
       )
  )
  (if (>= dval maxz)
    (progn
      ;; draw last level
      (if i3
(entmake
  (list (cons 0 "SOLID")
(cons 8 dval$)
(cons 420 cl)
(cons 10 pi1)
(cons 11 pi2)
(cons 12 (nth 2 pl))
(cons 13 (nth 2 pl))
  )
)
(entmake
  (list (cons 0 "SOLID")
(cons 8 dval$)
(cons 420 cl)
(cons 10 pi1)
(cons 11 pi2)
(cons 12 (nth 2 pl))
(cons 13 (nth 1 pl))
  )
)
      )
    )
  )
)
      )
    )
  )
  (princ)
)

;; returns a integer for 420 dxf group code, input: rgb list
(defun RGBToTrueColor (rgb / tcol)
  (setq r (lsh (car rgb) 16))
  (setq g (lsh (cadr rgb) 8))
  (setq b (caddr rgb))
  (setq tcol (+ (+ r g) b))
)

(princ)

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Unique xy point list but ignore z
« Reply #16 on: June 21, 2014, 12:17:53 PM »
no, because i need the HLS, that is the input i get.
but no worries, the doslib version is fine.

Simply switch the order of the supplied arguments  :wink:

Here are some suggestions (untested):
Code: [Select]
;*****************************************************************************;
; Initiated by XXL at TheSwamp                                                ;
; Modified by Lee Mac 2014-06-21                                              ;
; ** DOSLIB no longer required **                                             ;
;                                                                             ;
; June 2014                                                                   ;
; c:gcmap draws a gradient color map on a TIN                                 ;
; DOSLIB needs to be loaded for 'dos_hlstorgb' function                       ;
;*****************************************************************************;

(defun c:gcmap ( / col_hb col_he col_l col_s e hue_i i ival s sug_ival tinmaxz tinminz zl )

    (setq col_Hb   0 ;; color min hue value
          col_He 360 ;; color max hue value
          col_L  100 ;; color light
          col_S  100 ;; color saturation
    )
    (if (setq s (ssget '((0 . "3DFACE"))))
        (progn
            (repeat (setq i (sslength s))
                (setq e  (entget (ssname s (setq i (1- i))))
                      zl (vl-list* (cadddr (assoc 11 e)) (cadddr (assoc 12 e)) (cadddr (assoc 13 e)) zl)
                )
            )
            (setq TinMaxZ  (apply 'max zl) ;; min TIN elevation
                  TinMinZ  (apply 'min zl) ;; max TIN elevation
                  sug_ival (/ (- TinMaxZ TinMinZ) 20.0)  ;; compute an interval suggestion for about 20 levels
                  sug_ival (/ (fix (+ 0.5 (* sug_ival 1000.0))) 1000.0) ;; round to mm level
                  sug_ival  ;; computed suggestion is rounded
                (cond
                    (   (> sug_ival 1.000) (fix sug_ival))
                    (   (< sug_ival 0.099) (/ (fix (+ 0.5 (* 100.0 sug_ival))) 100.0))
                    (   (< sug_ival 0.999) (/ (fix (+ 0.5 (* 10.0  sug_ival)))  10.0))
                )
            )
            ;; get user interval input and verify
            (while
                (and
                    (setq ival (getreal (strcat "\nEnter interval (suggested: " (rtos sug_ival 2 3) "m): ")))
                    (> (/ (- TinMaxZ TinMinZ) ival) (- col_He col_Hb))
                )
                (alert "\nEntered interval is too small for color range, please choose a larger interval.")
            )
            (if (null ival)
                (setq ival sug_ival)
            )
            (prompt (strcat "\nComputing " (rtos (/ (- TinMaxZ TinMinZ) ival) 2 0) " elevation levels... "))

            ;; compute Hue increment for each elevation level based on color hue range, TIN delta elevation and interval
            (setq Hue_i (fix (/ (- col_He col_Hb) (/ (- TinMaxZ TinMinZ) ival))))

            ;; process every 3DFACE entity from selectionset s
            (repeat (setq i (sslength s))
                (trfill (ssname s (setq i (1- i))))
            )
            (princ "Done.")
        )
    )
    (princ)
)

;; fill every 3DFACE with gradient colors
(defun trfill ( e / cl dval dval$ ex i1 i2 i3 maxz minz pi1 pi2 pl )
    ;; create pointlist from 3Dface
    (setq ex    (entget e)
          pl    (vl-sort (mapcar '(lambda ( x ) (cdr (assoc x ex))) '(11 12 13)) '(lambda ( a b ) (> (caddr a) (caddr b))))
          maxz  (caddar pl)  ;; min and max elevation of 3Dface
          minz  (caddr (last pl))
          dval  (* ival (+ 1 (fix (/ minz ival))))
          dval$ (strcat "SOLID_" (rtos (- dval ival) 2 2))
    )
    (if (>= dval maxz)
        ;;; there will be no intersections, colour the entire 3DFACE with a single solid
        (entmake
            (vl-list*
               '(0 . "SOLID")
                (cons 008 dval$)
                (cons 420 (apply 'LM:RGB->True (LM:HSL->RGB (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i))) col_S col_L)))
                (mapcar 'cons '(10 11 12 13) (reverse (cons (car pl) pl)))
            )
        )
        (progn
            (setq pl (reverse pl))
            (while (< dval maxz)
                (setq cl (apply 'LM:RGB->True (LM:HSL->RGB (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i))) col_S col_L))
                      i2 (inters (car  pl) (cadr   pl) (list (caar  pl) (cadar  pl) dval) (list (caadr pl)  (cadadr pl) dval) t)
                      i1 (inters (car  pl) (caddr  pl) (list (caar  pl) (cadar  pl) dval) (list (caaddr pl) (cadadr (cdr pl)) dval) t)
                      i3 (inters (cadr pl) (caddr  pl) (list (caadr pl) (cadadr pl) dval) (list (caaddr pl) (cadadr (cdr pl)) dval) t)
                )
                (cond
                    (   (and i1 i2)
                        (entmake
                            (vl-list* '(0 . "SOLID") (cons 008 dval$) (cons 420 cl)
                                (mapcar 'cons '(10 11 12 13)
                                    (if (and (not pi1) (not pi2)) ;; no previous intersections on edges
                                        (list (car pl) i1 i2 i2)
                                        (list pi1 i1 pi2 i2)
                                    )
                                )
                            )
                        )
                        (setq pi1 i1
                              pi2 i2
                        )
                    )
                    (   (and i1 i3)
                        (entmake
                            (vl-list* '(0 . "SOLID") (cons 008 dval$) (cons 420 cl)
                                (mapcar 'cons '(10 11 12 13)
                                    (if (and (not pi1) (not pi2)) ;; no previous intersections on edges
                                        (list (car pl) i1 (cadr pl) i3)
                                        (list pi1 i1 pi2 i3)
                                    )
                                )
                            )
                        )
                        (if (and pi1 pi2 (< (caddr pi1) (caddr (cadr pl))))
                            (entmake
                                (vl-list* '(0 . "SOLID") (cons 008 dval$) (cons 420 cl)
                                    (mapcar 'cons '(10 11 12 13) (list pi2 i3 (cadr pl) (cadr pl)))
                                )
                            )
                        )
                        (setq pi1 i1
                              pi2 i3
                        )
                    )
                )
                (setq dval$ (strcat "SOLID_" (rtos dval 2 2))
                      dval  (+ ival dval)
                      cl    (apply 'LM:RGB->True (LM:HSL->RGB (+ col_Hb (fix (* (/ (- dval TinMinZ) ival) Hue_i))) col_S col_L))
                )
                (if (>= dval maxz)
                    (entmake
                        (vl-list* '(0 . "SOLID") (cons 008 dval$) (cons 420 cl)
                            (mapcar 'cons '(10 11 12 13)
                                (if i3
                                    (list pi1 pi2 (caddr pl) (caddr pl))
                                    (list pi1 pi2 (caddr pl) (cadr  pl))
                                )
                            )
                        )
                    )
                )
            )
        )
    )
    (princ)
)

;; RGB -> True  -  Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values

(defun LM:RGB->True ( r g b )
    (logior (lsh (fix r) 16) (lsh (fix g) 8) (fix b))
)

;; HSL -> RGB  -  Lee Mac
;; Args: [int] 0<=h<=360, 0<=s<=100, 0<=l<=100
 
(defun LM:HSL->RGB ( h s l / u v )
    (setq h (/ h 360.0)
          s (/ s 100.0)
          l (/ l 100.0)
    )
    (mapcar '(lambda ( x ) (fix (+ 0.5 (* 255 x))))
        (cond
            (   (zerop s) (list l l l))
            (   (zerop l)'(0 0 0))
            (   (setq v (if (< l 0.5) (* l (1+ s)) (- (+ l s) (* l s)))
                      u (-  (* 2.0 l) v)
                )
                (mapcar
                   '(lambda ( h )
                        (setq h (rem (1+ h) 1))
                        (cond
                            (   (< (* 6.0 h) 1.0) (+ u (* 6.0 h (- v u))))
                            (   (< (* 2.0 h) 1.0) v)
                            (   (< (* 3.0 h) 2.0) (+ u (* 6.0 (- (/ 2.0 3.0) h) (- v u))))
                            (   u   )
                        )
                    )
                    (list (+ h (/ 1.0 3.0)) h (- h (/ 1.0 3.0)))
                )
            )
        )
    )
)

(princ)
« Last Edit: June 22, 2014, 08:50:43 AM by Lee Mac »

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #17 on: June 21, 2014, 01:11:40 PM »
wow, thx ! you must be the Rossi of Lisp.
I swapped, i didn't work but probably swapped the wrong ones  :oops:, will try again.
I couldn't get your code to work, it gives error on i3 but i can't see what's wrong with it.


Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Unique xy point list but ignore z
« Reply #18 on: June 21, 2014, 01:14:46 PM »
wow, thx ! you must be the Rossi of Lisp.

 :-)

I swapped, i didn't work but probably swapped the wrong ones  :oops:, will try again.
I couldn't get your code to work, it gives error on i3 but i can't see what's wrong with it.

Sorry, I modified the code very quickly - there was a typo (an extra 'd') -
I have now updated the above code, hopefully there are no more bugs!

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #19 on: June 22, 2014, 02:42:33 AM »
thx, seems to work fine now but the colors are wierd, just like when i swapped the values.
Attached is an example TIN and the result with your code but with use of dos_hlstorgb (and swapped sl).

BTW: i see you use 008 for layer dxf group code instead of just 8, why is that ?

ty !

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #20 on: June 22, 2014, 04:35:42 AM »
Another question, assuming you use VLIDE, what settings and where do i change to get the same formatting as your code ?
ty !

edit: i now compared the old code with yours and i find it strange that yours is slower although tightly written ?  :roll:

Command: GCMAP
Select objects: Specify opposite corner: 668 found
Select objects:
Enter interval (suggested: 0.070m): 0.0075
Computing 189 elevation levels... done.
Elapsed time: 4.2900 secs.

Command:
Command: U
Command: GCMAP_OLD
Select objects: Specify opposite corner: 668 found
Select objects:
Enter interval (suggested: 0.070m): 0.0075
Computing 189 elevation levels...
"\nElapsed time: 3.5570 secs." done.
« Last Edit: June 22, 2014, 04:56:00 AM by XXL66 »

Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Unique xy point list but ignore z
« Reply #21 on: June 22, 2014, 08:54:25 AM »
thx, seems to work fine now but the colors are wierd, just like when i swapped the values.
Attached is an example TIN and the result with your code but with use of dos_hlstorgb (and swapped sl).

I have updated the colour parameter limits in the above posted code to:
Code: [Select]
    (setq col_Hb   0 ;; color min hue value
          col_He 360 ;; color max hue value
          col_L  100 ;; color light
          col_S  100 ;; color saturation
    )

Since these are the limits of the arguments for my LM:hsl->rgb function - maybe this will resolve the colour issues.

BTW: i see you use 008 for layer dxf group code instead of just 8, why is that ?

Just for aesthetics, so that the DXF codes are aligned  :ugly:

Another question, assuming you use VLIDE, what settings and where do i change to get the same formatting as your code ?

Yes, I use the VLIDE, but format code manually as I write it.

edit: i now compared the old code with yours and i find it strange that yours is slower although tightly written ?  :roll:

Yes, I may have sacrified some efficiency for concision with the mapcar expressions - why the eye roll?

XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #22 on: June 22, 2014, 10:49:02 AM »
hi, thx, just expected your code to be faster... because nice and tight

I don't use full HUE range because begin and end color would be almost the same and thus confusing. But later i want the range to be selectable, so you can choose your own sort of color swatch.
I don't think the problem has to do with light or saturation i would guess.
I will compare both and will try to print the differences.

But now i'm going to watch :mrgreen: (fFellaini) score against Russia.






Lee Mac

  • Seagull
  • Posts: 12313
  • London, England
Re: Unique xy point list but ignore z
« Reply #23 on: June 22, 2014, 10:58:45 AM »
But now i'm going to watch :mrgreen: (fFellaini) score against Russia.

Whatever the outcome, they're doing a lot better than England  :cry:


XXL66

  • Newt
  • Posts: 99
Re: Unique xy point list but ignore z
« Reply #24 on: June 23, 2014, 02:04:01 AM »
A lot better ? I almost fell asleep. All this euphory is almost embarrassing...