Author Topic: Display object inside the dialog (vector_image) again...  (Read 144 times)

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Bull Frog
  • Posts: 416
Display object inside the dialog (vector_image) again...
« on: November 09, 2017, 12:28:54 pm »
Hey guys,
Today I've decided to put some practice on the vector_image function, since I realised I've got lacks at it.
Before I always used Lee's LM:DisplayBitmap function, which helps alot when dealing with image tiles in DCL - however it has a different purpose.

Soo.. the idea I came up with was to:
1. Select a polyline
2. Extract its coordinates
3. Display them in the dialog, using the vector_image function


Needless to say, later I've decided just to use Lee's LM:Entity->PointList for a more generic object selection.

However the questions I have now are:
1. How to automatically rescale the coordinates, so they would fit to the image tile's size?
    At the moment I'm just using a custom scale factor to rescale the unit coords into pixel coords - check the lambda block.
2. The image doesn't display correctly, theres always one line that shifts-off and leaves a gap (see the picture)

Heres the code I'm practicing with:
Code - Auto/Visual Lisp: [Select]
  1. (defun C:test ( / _PickEnt *error* dcl des dch dcf L )
  2.  
  3.  (defun *error* ( msg )
  4.    (and (< 0 dch) (unload_dialog dch))
  5.    (and (eq 'FILE (type des)) (close des))
  6.    (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
  7.    (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)))) (princ)
  8.  ); defun *error*
  9.  
  10.  (cond
  11.    (
  12.      (not
  13.        (setq L
  14.          (
  15.            (setq _PickEnt
  16.              (lambda ( / e enx r ll ur bbox cen ) (setvar 'errno 0)
  17.                (while (/= 52 (getvar 'errno)) (setq e (car (entsel "\nSelect some object: ")))
  18.                  (cond
  19.                    ( (= 7 (getvar 'errno)) (setvar 'errno 0)) ( (not e) )
  20.                    ; ( (not (member '(0 . "LWPOLYLINE") (setq enx (entget e)))) )
  21.                    (
  22.                      ; (setq r (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) enx)))
  23.                      ; (if (= 1 (logand 1 (cdr (assoc 70 enx)))) (setq r (cons (last r) r)))
  24.                      (setq r (LM:Entity->PointList e))
  25.                      (vla-GetBoundingBox (vlax-ename->vla-object e) 'll 'ur)
  26.                      (setq cen (apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (setq bbox (mapcar 'vlax-safearray->list (list ll ur)))))) ; LM
  27.                      (setvar 'errno 52)
  28.                    )
  29.                  ); cond
  30.                ); while
  31.                (if r (list cen bbox r))
  32.              ); lambda
  33.            ); setq _PickEnt
  34.          )
  35.        ); setq L
  36.      ); not
  37.    )
  38.    (
  39.      (not
  40.        (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
  41.          (mapcar (function (lambda (x) (princ (strcat "\n" x) des)))
  42.            '("test : dialog"
  43.              "{ label = \"Display Something\"; spacer;"
  44.              "  : column "
  45.              "  {"
  46.              "    : image "
  47.              "    { key = \"img\"; height = 16.0; width = 48.0; "
  48.              "      fixed_width = true; fixed_height = true;"
  49.              "      horizontal_margin = none; vertical_margin = none;"
  50.              "      alignment = centered; color = -15;"
  51.              "    }"
  52.              "    : button { label = \"Select >>\"; key = \"b\"; alignment = centered; fixed_width = true; }"
  53.              "  }"
  54.              "  spacer; ok_only;"
  55.              "}"
  56.            ); list
  57.          ); mapcar
  58.          (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
  59.        ); and
  60.      ); not
  61.      (prompt "\nUnable to write or load the DCL file.")
  62.    )
  63.    (
  64.      (progn
  65.        (while (not (member dcf '(0 1)))
  66.          (cond ; Inside the dialog
  67.            ( (not (new_dialog "test" dch)) (prompt "\nUnable to display the dialog") (setq dcf 0) )
  68.            (T
  69.              (action_tile "b" "(done_dialog 2)")
  70.  
  71.              ; (
  72.              ; (lambda ( scf c bbox xL / sc x1 y1 x2 y2 sx sy ) ; First obtain the image's size
  73.              ; (setq sx (dimx_tile "img"))
  74.              ; (setq sy (dimy_tile "img"))
  75.              ; (setq sc (* scf (/ (distance (list sx 0.) (list 0. sy)) (apply 'distance bbox))))
  76.              ; (start_image "img")
  77.              ; (while xL ; (while) approach, to step thru every 2 elements of the list
  78.              ; (and
  79.              ; (vl-every 'set '(x1 y1) (mapcar '- c (car xL))) ; first point - translated from the centroid
  80.              ; (vl-every 'set '(x2 y2) (mapcar '- c (cadr xL))) ; second point - translated from the centroid
  81.              ; (mapcar 'set '(x1 y1 x2 y2) (mapcar '(lambda (xx) (* xx sc)) (list x1 y1 x2 y2))) ; use the scale factor to rescale the vector's size
  82.              ; (apply 'vector_image ;  (vector_image x1 y1 x2 y2 color)
  83.              ; (mapcar 'fix ; fix is required for the (vector_image) function
  84.              ; (list ; translate the pixelated coordinates so all vectors would be centered  
  85.              ; (+ (/ sx 2.0) (- x1)) ; x-coords must be reversed, else the image seems to be mirrored
  86.              ; (+ (/ sy 2.0) y1)
  87.              ; (+ (/ sx 2.0) (- x2)) ; x-coords must be reversed, else the image seems to be mirrored
  88.              ; (+ (/ sy 2.0) y2)
  89.              ; 15 ; colour
  90.              ; ); list
  91.              ; ); mapcar 'fix
  92.              ; ); apply 'vector_image
  93.              ; ); and
  94.              ; (setq xL (cdr xL))
  95.              ; ); while
  96.              ; (end_image) ; Result is as expected, but some extra line appears
  97.              ; ); lambda
  98.              ; 0.8 ; scale factor, units to pixels - How do I scale up to the image's limits?
  99.              ; (car L) ; centroid
  100.              ; (cadr L) ; bbox
  101.              ; (caddr L) ; point list
  102.              ; )
  103.  
  104.              (
  105.                (lambda ( scf c bbox xL / sc x1 y1 x2 y2 sx sy ) ; First obtain the image's size
  106.                  (setq sx (dimx_tile "img")) (setq sy (dimy_tile "img"))
  107.                  (setq sc (* scf (abs (apply 'max (mapcar '/ (list sx sy) (apply 'mapcar (cons '- bbox)))))))  ; _$ (mapcar '- '(3 2 1) '(1 2 3)) -> (2 0 -2) ; _$ (apply 'mapcar (cons '- '((3 2 1) (1 2 3)))) -> (2 0 -2)
  108.                  ; (setq sc (* scf (/ (distance (list sx 0.) (list 0. sy)) (apply 'distance bbox)))) ; scale by diagonal - incorrect
  109.                  (setq xL (mapcar '(lambda (x) (mapcar '(lambda (xx) (* xx sc)) (mapcar '- c x))) xL))
  110.                  (start_image "img")
  111.                  (while xL ; (while) approach, to step thru every 2 elements of the list
  112.                    (and
  113.                      (vl-every 'set '(x1 y1) (car xL))
  114.                      (vl-every 'set '(x2 y2) (cadr xL))
  115.                      (apply 'vector_image ;  (vector_image x1 y1 x2 y2 color)
  116.                        (mapcar 'fix ; fix is required for the (vector_image) function
  117.                          (list ; translate the pixelated coordinates so all vectors would be centered  
  118.                            (+ (/ sx 2.0) (- x1)) ; x-coords must be reversed, else the image seems to be mirrored
  119.                            (+ (/ sy 2.0) y1)
  120.                            (+ (/ sx 2.0) (- x2)) ; x-coords must be reversed, else the image seems to be mirrored
  121.                            (+ (/ sy 2.0) y2)
  122.                            15 ; colour
  123.                          ); list
  124.                        ); mapcar 'fix
  125.                      ); apply 'vector_image
  126.                    ); and
  127.                    (setq xL (cdr xL))
  128.                  ); while
  129.                  (end_image) ; Result is as expected, but some extra line appears
  130.                ); lambda
  131.                0.8 ; scale factor, units to pixels - How do I scale up to the image's limits?
  132.                (car L) ; centroid
  133.                (cadr L) ; bbox
  134.                (caddr L) ; point list
  135.              )
  136.  
  137.  
  138.              ; (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (vl-prin1-to-string x))) (caddr L))))
  139.              (setq dcf (start_dialog))
  140.            ); T
  141.          ); cond ; Inside the dialog
  142.          (cond ; Outside the dialog - Its hidden
  143.            ( (= 2 dcf) ((lambda ( / tmp) (if (setq tmp (_PickEnt)) (setq L tmp)))) )
  144.          ); cond ; Outside the dialog - Its hidden
  145.        ); while
  146.        (/= 1 dcf)
  147.      ); progn
  148.      (prompt "\nUser cancelled or terminated the dialog.")
  149.    )
  150.    (T
  151.      ; < Proceed with the outputs >
  152.    ); T
  153.  ); cond
  154.  (*error* nil) (princ)
  155. ); defun
  156.  
  157.  
  158.  
  159. ;;----------------=={ Entity to Point List }==----------------;;
  160. ;;                                                            ;;
  161. ;;  Returns a list of points describing or approximating the  ;;
  162. ;;  supplied entity, else nil if the entity is not supported. ;;
  163. ;;------------------------------------------------------------;;
  164. ;;  Author: Lee Mac, Copyright 2011 - www.lee-mac.com       ;;
  165. ;;------------------------------------------------------------;;
  166. ;;  Arguments:                                                ;;
  167. ;;  ent - Entity for which to return Point List.              ;;
  168. ;;------------------------------------------------------------;;
  169. ;;  Returns:  List of Points describing/approximating entity  ;;
  170. ;;------------------------------------------------------------;;
  171.  
  172. (defun LM:Entity->PointList ( ent / der di1 di2 di3 elst fun inc lst par rad )
  173.  (setq elst (entget ent))
  174.  (cond
  175.    (   (eq "POINT" (cdr (assoc 0 elst)))
  176.      (list (cdr (assoc 10 elst)))
  177.    )
  178.    (   (eq "LINE" (cdr (assoc 0 elst)))
  179.      (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
  180.    )
  181.    (   (member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
  182.      (setq di1 0.0
  183.        inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
  184.        fun (if (vlax-curve-isclosed ent) < <=)
  185.      )
  186.      (while (fun di1 di2)
  187.        (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  188.          di1 (+ di1 inc)
  189.        )
  190.      )
  191.      lst
  192.    )
  193.    (   (or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
  194.      (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80)))
  195.    )
  196.    (setq par 0)
  197.      (if (setq der (vlax-curve-getsecondderiv ent par))
  198.        (if (equal der '(0.0 0.0 0.0) 1e-8)
  199.          (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
  200.          (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
  201.            di1 (vlax-curve-getdistatparam ent par)
  202.            di2 (vlax-curve-getdistatparam ent (1+ par))
  203.          )
  204.          (progn
  205.            (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
  206.            (while (< di1 di2)
  207.              (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  208.                di1 (+ di1 inc)
  209.              )
  210.            )
  211.          )
  212.          )
  213.        )
  214.      )
  215.      (setq par (1+ par))
  216.    )
  217.    (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-8))
  218.      lst
  219.      (cons (vlax-curve-getendpoint ent) lst)
  220.    )
  221.    )
  222.    (   (eq (cdr (assoc 0 elst)) "ELLIPSE")
  223.        di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  224.        di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))))
  225.      )
  226.      (while (< di1 di2)
  227.        (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  228.          der (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1)))
  229.          di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
  230.        )
  231.      )
  232.      (if (vlax-curve-isclosed ent)
  233.        lst
  234.        (cons (vlax-curve-getendpoint ent) lst)
  235.      )
  236.    )
  237.    (   (eq (cdr (assoc 0 elst)) "SPLINE")
  238.        di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  239.        inc (/ di2 25.0)
  240.      )
  241.      (while (< di1 di2)
  242.        (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  243.          der (/ (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1))) inc)
  244.          di1 (+ di1 (if (equal 0.0 der 1e-10) inc (min inc (/ 1.0 der (* 10. inc)))))
  245.        )
  246.      )
  247.      (if (vlax-curve-isclosed ent)
  248.        lst
  249.        (cons (vlax-curve-getendpoint ent) lst)
  250.      )
  251.    )
  252.  )
  253. )
« Last Edit: November 10, 2017, 05:26:27 pm by Grrr1337 »

Lee Mac

  • Seagull
  • Posts: 11834
  • AutoCAD 2015 Windows 7 London, England
Re: Display object inside the dialog (vector_image) again...
« Reply #1 on: November 09, 2017, 12:30:44 pm »
This should hopefully answer your questions:

https://www.theswamp.org/index.php?topic=42413.0

Grrr1337

  • Bull Frog
  • Posts: 416
Re: Display object inside the dialog (vector_image) again...
« Reply #2 on: November 09, 2017, 01:26:54 pm »
Thanks Lee,
Actually I had your BlockPreview already opened in NP++.

But I'm too frustrated from your code - this is another lambda attempt, to substitute the previous one:
Code - Auto/Visual Lisp: [Select]
  1.              (
  2.                (lambda ( bbox margin vL key / xt yt mi mx r1 r2 sc vc )
  3.                  (cond
  4.                    ( (or (< margin 0) (<= (setq xt (dimx_tile key)) (* 2 margin)) (<= (setq yt (dimy_tile key)) (* 2 margin)) ) nil)
  5.                    (
  6.                      (setq
  7.                        mi (car bbox)
  8.                        mx (cadr bbox)
  9.                        ; mi (apply 'mapcar (cons 'min vL))
  10.                        ; mx (apply 'mapcar (cons 'max vL))
  11.                        ; mi (list (min (car mi) (caddr mi)) (min (cadr mi) (cadddr mi)))
  12.                        ; mx (list (max (car mx) (caddr mx)) (max (cadr mx) (cadddr mx)))
  13.                        r1 (/ (- (car  mx) (car  mi)) (- xt (* 2 margin)))
  14.                        r2 (/ (- (cadr mx) (cadr mi)) (- yt (* 2 margin)))
  15.                      ); setq
  16.                      (cond
  17.                        (   (and (equal r1 r2 1e-8) (equal r1 0.0 1e-8))
  18.                          (setq sc 1.0
  19.                            vc (mapcar '- mi (list (/ xt 2.0) (/ yt 2.0)))
  20.                          )
  21.                        )
  22.                        (   (equal r1 r2 1e-8)
  23.                          (setq sc r1
  24.                            vc (mapcar '(lambda ( x ) (- x (* sc margin))) mi)
  25.                          )
  26.                        )
  27.                        (   (< r1 r2)
  28.                          (setq sc r2)
  29.                          (setq vc
  30.                            (list
  31.                              (- (car  mi) (/ (- (* sc xt) (- (car mx) (car mi))) 2.0))
  32.                              (- (cadr mi) (* sc margin))
  33.                            )
  34.                          )
  35.                        )
  36.                        (   t
  37.                          (setq sc r1)
  38.                          (setq vc
  39.                            (list
  40.                              (- (car  mi) (* sc margin))
  41.                              (- (cadr mi) (/ (- (* sc yt) (- (cadr mx) (cadr mi))) 2.0))
  42.                            )
  43.                          )
  44.                        )
  45.                      ); cond
  46.                      (setq vc (append vc vc))
  47.                      (start_image key)
  48.                      (foreach x vL
  49.                        ; (mapcar
  50.                          ; (function
  51.                            ; (lambda ( a / x )
  52.                              ; (setq x (mapcar '(lambda ( a b ) (fix (/ (- a b) sc))) a vc))
  53.                              ; (list
  54.                                ; (car x)
  55.                                ; (- yt (cadr x))
  56.                                ; (caddr x)
  57.                                ; (- yt (cadddr x))
  58.                                ; (last a)
  59.                              ; )
  60.                            ; )
  61.                          ; )
  62.                          ; vL
  63.                        ; )
  64.                        (apply 'vector_image (append (mapcar '(lambda (xx) (fix (/ xx sc))) x) '(1)))
  65.                      )
  66.                      (end_image)
  67.                    ); T
  68.                  ); cond
  69.                ); lambda
  70.                (cadr L)
  71.                0. ; margin
  72.                (caddr L) ; vL - vectors
  73.                "img" ; key
  74.              )
But it fails, and I got lost.  :thinking:



EDIT:
Ok, solved step 1 - code corrected.
I've implemented a small adjustment in row 75, so I got lucky to avoid digestion of Lee's code.

Still remains the issue #2, and no idea why that happens (the shifted line and the gap).

EDIT2:
Managed to partially fix the issue in #2 (the extra line is removed, but the gap remains in some cases) :
Code - Auto/Visual Lisp: [Select]
  1.              (
  2.                (lambda ( scf c bbox xL / sc x1 y1 x2 y2 sx sy ) ; First obtain the image's size
  3.                  (setq sx (dimx_tile "img"))
  4.                  (setq sy (dimy_tile "img"))
  5.                  (setq sc (* scf (/ (distance (list sx 0.) (list 0. sy)) (apply 'distance bbox))))
  6.                  (setq xL (mapcar '(lambda (x) (mapcar '(lambda (xx) (* xx sc)) (mapcar '- c x))) xL))
  7.                  (start_image "img")
  8.                  (while xL ; (while) approach, to step thru every 2 elements of the list
  9.                    (and
  10.                      (vl-every 'set '(x1 y1) (car xL))
  11.                      (vl-every 'set '(x2 y2) (cadr xL))
  12.                      (apply 'vector_image ;  (vector_image x1 y1 x2 y2 color)
  13.                        (mapcar 'fix ; fix is required for the (vector_image) function
  14.                          (list ; translate the pixelated coordinates so all vectors would be centered  
  15.                            (+ (/ sx 2.0) (- x1)) ; x-coords must be reversed, else the image seems to be mirrored
  16.                            (+ (/ sy 2.0) y1)
  17.                            (+ (/ sx 2.0) (- x2)) ; x-coords must be reversed, else the image seems to be mirrored
  18.                            (+ (/ sy 2.0) y2)
  19.                            15 ; colour
  20.                          ); list
  21.                        ); mapcar 'fix
  22.                      ); apply 'vector_image
  23.                    ); and
  24.                    (setq xL (cdr xL))
  25.                  ); while
  26.                  (end_image) ; Result is as expected, but some extra line appears
  27.                ); lambda
  28.                0.8 ; scale factor, units to pixels - How do I scale up to the image's limits?
  29.                (car L) ; centroid
  30.                (cadr L) ; bbox
  31.                (caddr L) ; point list
  32.              )
« Last Edit: November 09, 2017, 02:22:04 pm by Grrr1337 »

roy_043

  • Swamp Rat
  • Posts: 1492
  • BricsCAD 16
Re: Display object inside the dialog (vector_image) again...
« Reply #3 on: November 10, 2017, 10:18:25 am »
Hint: The gap will occur if the selected curve is closed.

Grrr1337

  • Bull Frog
  • Posts: 416
Re: Display object inside the dialog (vector_image) again...
« Reply #4 on: November 10, 2017, 05:29:34 pm »
Not sure what happened but now it seems to display objects correctly - I've modified the code in my main post.
I also modified the scale calculations, since I rescaled the image vectors by comparing the diagonals (which is wrong).

 :idea: Interesting stuff can be displayed with such technique ...

« Last Edit: November 10, 2017, 06:32:49 pm by Grrr1337 »

roy_043

  • Swamp Rat
  • Posts: 1492
  • BricsCAD 16
Re: Display object inside the dialog (vector_image) again...
« Reply #5 on: November 11, 2017, 03:15:46 am »
Hint: The gap will occur if the selected curve is closed.
You seem to have missed this comment...

Grrr1337

  • Bull Frog
  • Posts: 416
Re: Display object inside the dialog (vector_image) again...
« Reply #6 on: November 11, 2017, 04:59:26 am »
Hint: The gap will occur if the selected curve is closed.
You seem to have missed this comment...

I did not, Roy...
but I'm not sure whats the reason, since the point list is always 'closed' (tested on a rectangle - and got 5 points in the list).
Maybe LM:Entity->PointList fails?

roy_043

  • Swamp Rat
  • Posts: 1492
  • BricsCAD 16
Re: Display object inside the dialog (vector_image) again...
« Reply #7 on: November 12, 2017, 03:00:25 pm »
You must be working with a different version of Lee's code than the one you are showing here.