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

0 Members and 1 Guest are viewing this topic.

Grrr1337

  • Swamp Rat
  • Posts: 704
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 »
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

Lee Mac

  • Seagull
  • Posts: 12283
  • 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

  • Swamp Rat
  • Posts: 704
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 »
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

roy_043

  • Water Moccasin
  • Posts: 1731
  • BricsCAD 18
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

  • Swamp Rat
  • Posts: 704
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 »
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

roy_043

  • Water Moccasin
  • Posts: 1731
  • BricsCAD 18
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

  • Swamp Rat
  • Posts: 704
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?
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)

roy_043

  • Water Moccasin
  • Posts: 1731
  • BricsCAD 18
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.

RaKaMa

  • Mosquito
  • Posts: 3
Re: Display object inside the dialog (vector_image) again...
« Reply #8 on: February 25, 2018, 06:09:00 AM »
A points list, even with common end points, when converted to a polyline may not be closed.
Is that what Roy is suggesting?
It may also depend on version of AC.
« Last Edit: March 02, 2018, 04:07:48 PM by RaKaMa »