更新定义及其所有块引用？- 别再问我这个了!!!!

(defun c:binsert ( / *error* LM:BlockPreview RefGeom LM:Entity->PointList trp mxm mxv _blockpreview _ins dcl def des lst tmp bln )
 
    (vl-load-com)
 
    (defun *error* ( msg )
        (if (
            (unload_dialog dcl)
        )
        (if (= 'file (type des))
            (close des)
        )
        (if (and tmp (findfile tmp))
            (vl-file-delete tmp)
        )
        (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
 
    (defun-q LM:BlockPreview ( key block margin / _getcolour _getvectors _unique bn cache dy ec el en mi mx pl r1 r2 sc vc vl xt yt )
        (setq cache '( ))
 
        (defun _getcolour ( l / c )
            (cond
                (   (= 0 (setq c (cdr (assoc 62 l))))
                    7
                )
                (   (or (null c) (= 256 c))
                    (abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 l))))))
                )
                (   c   )
            )
        )
 
        (defun _getvectors ( bn / ec el en pl rg vl )
            (if (setq en (tblobjname "BLOCK" bn))
                (while (setq en (entnext en))
                    (setq el (entget en))
                    (cond
                        (   (= 1 (cdr (assoc 60 el))))
                        (   (= "INSERT" (cdr (assoc 0 el)))
                            (setq rg (RefGeom en))
                            (setq vl
                                (append vl
                                    (mapcar
                                        (function
                                            (lambda ( x )
                                                (append
                                                    (mapcar '+ (mxv (car rg) (list (car   x) (cadr   x) 0.0)) '(0 0) (cadr rg))
                                                    (mapcar '+ (mxv (car rg) (list (caddr x) (cadddr x) 0.0)) '(0 0) (cadr rg))
                                                    (cddddr x)
                                                )
                                            )
                                        )
                                        (_getvectors (cdr (assoc 2 el)))
                                    )
                                )
                            )
                        )
                        (   (setq pl (LM:Entity->PointList en))
                            (if (or (= "POINT" (cdr (assoc 0 el))) (vlax-curve-isclosed en))
                                (setq pl (cons (last pl) pl))
                            )
                            (setq ec (_getcolour el))
                            (setq vl
                                (append vl
                                    (mapcar
                                        (function
                                            (lambda ( a b )
                                                (list (car a) (cadr a) (car b) (cadr b) ec)
                                            )
                                        )
                                        pl (cdr pl)
                                    )
                                )
                            )
                        )
                    )
                )
            )
            vl
        )
 
        (defun _unique ( l / a r )
            (while (setq a (car l))
                (setq r (cons a r)
                      l (vl-remove-if (function (lambda ( b ) (equal a b))) (cdr l))
                )
            )
            (reverse r)
        )
 
        (cond
            (   (or (
                    (
                    (
                )
                nil
            )
            (   (setq vl (assoc (strcase block) cache))
                (foreach x (cdr vl) (apply 'vector_image x))
                t
            )            
            (   (setq vl (_getvectors block))
                (setq mi (apply 'mapcar (cons 'min vl))
                      mx (apply 'mapcar (cons 'max vl))
                      mi (list (min (car mi) (caddr mi)) (min (cadr mi) (cadddr mi)))
                      mx (list (max (car mx) (caddr mx)) (max (cadr mx) (cadddr mx)))
                      r1 (/ (- (car  mx) (car  mi)) (- xt (* 2 margin)))
                      r2 (/ (- (cadr mx) (cadr mi)) (- yt (* 2 margin)))
                )
                (cond
                    (   (and (equal r1 r2 1e-8) (equal r1 0.0 1e-8))
                        (setq sc 1.0
                              vc (mapcar '- mi (list (/ xt 2.0) (/ yt 2.0)))
                        )
                    )
                    (   (equal r1 r2 1e-8)
                        (setq sc r1
                              vc (mapcar '(lambda ( x ) (- x (* sc margin))) mi)
                        )
                    )
                    (   (
                        (setq sc r2)
                        (setq vc
                            (list
                                (- (car  mi) (/ (- (* sc xt) (- (car mx) (car mi))) 2.0))
                                (- (cadr mi) (* sc margin))
                            )
                        )
                    )
                    (   t
                        (setq sc r1)
                        (setq vc
                            (list
                                (- (car  mi) (* sc margin))
                                (- (cadr mi) (/ (- (* sc yt) (- (cadr mx) (cadr mi))) 2.0))
                            )
                        )
                    )
                )
                (setq vc (append vc vc))
                (   (setq LM:BlockPreview
                        (vl-list* '( key block margin )
                             (list 'setq 'cache
                                 (list 'quote
                                     (cons
                                         (cons (strcase block)
                                             (_unique
                                                 (mapcar
                                                     (function
                                                         (lambda ( a / x )
                                                             (setq x (mapcar '(lambda ( a b ) (fix (/ (- a b) sc))) a vc))
                                                             (list
                                                                 (car x)
                                                                 (- yt (cadr x))
                                                                 (caddr x)
                                                                 (- yt (cadddr x))
                                                                 (last a)
                                                             )
                                                         )
                                                     )
                                                     vl
                                                 )
                                             )
                                         )
                                         cache
                                     )
                                 )
                             )
                             (cddr LM:BlockPreview)
                        )
                    )
                    key block margin
                )
            )
        )
    )
 
    (defun RefGeom ( ename / elst ang norm mat )
        (setq elst (entget ename)
              ang  (cdr (assoc 50 elst))
              norm (cdr (assoc 210 elst))
        )
        (list
            (setq mat
                (mxm
                    (mapcar '(lambda ( v ) (trans v 0 norm t))
                       '(
                            (1.0 0.0 0.0)
                            (0.0 1.0 0.0)
                            (0.0 0.0 1.0)
                        )
                    )
                    (mxm
                        (list
                            (list (cos ang) (- (sin ang)) 0.0)
                            (list (sin ang) (cos ang)     0.0)
                           '(0.0 0.0 1.0)
                        )
                        (list
                            (list (cdr (assoc 41 elst)) 0.0 0.0)
                            (list 0.0 (cdr (assoc 42 elst)) 0.0)
                            (list 0.0 0.0 (cdr (assoc 43 elst)))
                        )
                    )
                )
            )
            (mapcar '- (trans (cdr (assoc 10 elst)) norm 0)
                (mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst))))))
            )
        )
    )
 
    (defun LM:Entity->PointList ( ent / der di1 di2 di3 elst fun inc lst par rad )
        (setq elst (entget ent))
        (cond
            (   (eq "POINT" (cdr (assoc 0 elst)))
                (list (cdr (assoc 10 elst)))
            )
            (   (eq "LINE" (cdr (assoc 0 elst)))
                (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
            )
            (   (member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
                (setq di1 0.0
                      di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
                      inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
                      fun (if (vlax-curve-isclosed ent) 
                )
                (while (fun di1 di2)
                    (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                          di1 (+ di1 inc)
                    )
                )
                lst
            )
            (   (or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
                    (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80)))
                )
                (setq par 0)
                (repeat (fix (1+ (vlax-curve-getendparam ent)))
                    (if (setq der (vlax-curve-getsecondderiv ent par))
                        (if (equal der '(0.0 0.0 0.0) 1e-8)
                            (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
                            (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
                                      di1 (vlax-curve-getdistatparam ent par)
                                      di2 (vlax-curve-getdistatparam ent (1+ par))
                                )
                                (progn
                                    (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
                                    (while (
                                        (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                                              di1 (+ di1 inc)
                                        )
                                    )
                                )
                            )
                        )
                    )
                    (setq par (1+ par))
                )
                (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-8))
                    lst
                    (cons (vlax-curve-getendpoint ent) lst)
                )
            )
            (   (eq (cdr (assoc 0 elst)) "ELLIPSE")
                (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
                      di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
                      di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))))
                )
                (while (
                    (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                          der (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1)))
                          di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
                    )
                )
                (if (vlax-curve-isclosed ent)
                    lst
                    (cons (vlax-curve-getendpoint ent) lst)
                )
            )
            (   (eq (cdr (assoc 0 elst)) "SPLINE")
                (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
                      di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
                      inc (/ di2 25.0)
                )
                (while (
                    (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                          di1 (+ di1 inc)
                    )
                )
                (if (vlax-curve-isclosed ent)
                    lst
                    (cons (vlax-curve-getendpoint ent) lst)
                )
            )
        )
    )
 
    (defun trp ( m )
        (apply 'mapcar (cons 'list m))
    )
 
    (defun mxm ( m n )
        ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
    )
 
    (defun mxv ( m v )
        (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
    )
 
    (defun _blockpreview ( blk )
        (start_image "img")
        (fill_image 0 0 (dimx_tile "img") (dimy_tile "img") 0)
        (LM:BlockPreview "img" blk 5)
        (end_image)
    )
 
    (defun _ins ( bln )
        (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "_.-INSERT\n" bln "\n"))
    )
 
    (while (setq def (tblnext "BLOCK" (null def)))
        (if
            (and
                (= 0 (logand 125 (cdr (assoc 70 def))))
                (not (wcmatch (cdr (assoc 2 def)) "`_*,`**,*|*"))
            )
            (setq lst (cons (cdr (assoc 2 def)) lst))
        )
    )
 
    (cond
        (   (null (setq lst (vl-sort lst '
            (princ "\nNo blocks found in drawing.")
        )
        (   (null
                (and
                    (setq tmp (vl-filename-mktemp nil nil ".dcl"))
                    (setq des (open tmp "w"))
                    (foreach line
                       '(
                            "blockpreview : dialog"
                            "{"
                            "    label = "Block Preview";"
                            "    initial_focus = "lst";"
                            "    spacer;"
                            "    : row"
                            "    {"
                            "        : list_box { key = "lst"; width = 30.0; fixed_width = true; }"
                            "        spacer;"
                            "        : image"
                            "        {"
                            "            key = "img";"
                            "            width = 33.5;"
                            "            aspect_ratio = 1.0;"
                            "            fixed_width = true;"
                            "            fixed_height = true;"
                            "        }"
                            "    }"
                            "    spacer;"
                            "    ok_cancel;"
                            "}"
                        )
                        (write-line line des)
                    )
                    (not (setq des (close des)))
                    (
                    (new_dialog "blockpreview" dcl)
                )
            )
            (princ "\nUnable to load dialog.")
        )
        (   t
            (start_list "lst")
            (foreach x lst (add_list x))
            (end_list)
 
            (set_tile "lst" "0")
            (setq bln (nth 0 lst))
            (_blockpreview (car lst))
 
            (action_tile "lst" "(_blockpreview (setq bln (nth (atoi $value) lst)))")
            (action_tile "accept" "(progn(_ins bln)(done_dialog 1))")
            (action_tile "cancel" "(done_dialog 0)")
            (start_dialog)
        )
    )
    (*error* nil)
)
 

(defun c:binsert-tiles ( / *error* LM:BlockPreview RefGeom LM:Entity->PointList trp mxm mxv _blockpreview _blockpreview-highlight _ins dcl def des lst tmp k q bln )
 
  (vl-load-com)
 
  (defun *error* ( msg )
    (if (
      (unload_dialog dcl)
    )
    (if (= 'file (type des))
      (close des)
    )
    (if (and tmp (findfile tmp))
      (vl-file-delete tmp)
    )
    (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )
 
  (defun-q LM:BlockPreview ( key block margin / _getcolour _getvectors _unique bn cache dy ec el en mi mx pl r1 r2 sc vc vl xt yt )
    (setq cache '( ))
 
    (defun _getcolour ( l / c )
      (cond
        ( (= 0 (setq c (cdr (assoc 62 l))))
          7
        )
        ( (or (null c) (= 256 c))
          (abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 l))))))
        )
        ( c )
      )
    )
 
    (defun _getvectors ( bn / ec el en pl rg vl )
      (if (setq en (tblobjname "BLOCK" bn))
        (while (setq en (entnext en))
          (setq el (entget en))
          (cond
            ( (= 1 (cdr (assoc 60 el))))
            ( (= "INSERT" (cdr (assoc 0 el)))
              (setq rg (RefGeom en))
              (setq vl
                (append vl
                  (mapcar
                    (function
                      (lambda ( x )
                        (append
                          (mapcar '+ (mxv (car rg) (list (car   x) (cadr   x) 0.0)) '(0 0) (cadr rg))
                          (mapcar '+ (mxv (car rg) (list (caddr x) (cadddr x) 0.0)) '(0 0) (cadr rg))
                          (cddddr x)
                        )
                      )
                    )
                    (_getvectors (cdr (assoc 2 el)))
                  )
                )
              )
            )
            ( (setq pl (LM:Entity->PointList en))
              (if (or (= "POINT" (cdr (assoc 0 el))) (vlax-curve-isclosed en))
                (setq pl (cons (last pl) pl))
              )
              (setq ec (_getcolour el))
              (setq vl
                (append vl
                  (mapcar
                    (function
                      (lambda ( a b )
                        (list (car a) (cadr a) (car b) (cadr b) ec)
                      )
                    )
                    pl (cdr pl)
                  )
                )
              )
            )
          )
        )
      )
      vl
    )
 
    (defun _unique ( l / a r )
      (while (setq a (car l))
        (setq r (cons a r)
              l (vl-remove-if (function (lambda ( b ) (equal a b))) (cdr l))
        )
      )
      (reverse r)
    )
 
    (cond
      ( (or (
          (
          (
        )
        nil
      )
      ( (setq vl (assoc (strcase block) cache))
        (foreach x (cdr vl) (apply 'vector_image x))
        t
      )            
      ( (setq vl (_getvectors block))
        (setq mi (apply 'mapcar (cons 'min vl))
              mx (apply 'mapcar (cons 'max vl))
              mi (list (min (car mi) (caddr mi)) (min (cadr mi) (cadddr mi)))
              mx (list (max (car mx) (caddr mx)) (max (cadr mx) (cadddr mx)))
              r1 (/ (- (car  mx) (car  mi)) (- xt (* 2 margin)))
              r2 (/ (- (cadr mx) (cadr mi)) (- yt (* 2 margin)))
        )
        (cond
          ( (and (equal r1 r2 1e-8) (equal r1 0.0 1e-8))
            (setq sc 1.0
                  vc (mapcar '- mi (list (/ xt 2.0) (/ yt 2.0)))
            )
          )
          ( (equal r1 r2 1e-8)
            (setq sc r1
                  vc (mapcar '(lambda ( x ) (- x (* sc margin))) mi)
            )
          )
          ( (
            (setq sc r2)
            (setq vc
              (list
                (- (car  mi) (/ (- (* sc xt) (- (car mx) (car mi))) 2.0))
                (- (cadr mi) (* sc margin))
              )
            )
          )
          ( t
            (setq sc r1)
            (setq vc
              (list
                (- (car  mi) (* sc margin))
                (- (cadr mi) (/ (- (* sc yt) (- (cadr mx) (cadr mi))) 2.0))
              )
            )
          )
        )
        (setq vc (append vc vc))
        ( (setq LM:BlockPreview
            (vl-list* '( key block margin )
              (list 'setq 'cache
                (list 'quote
                  (cons
                    (cons (strcase block)
                      (_unique
                        (mapcar
                          (function
                            (lambda ( a / x )
                              (setq x (mapcar '(lambda ( a b ) (fix (/ (- a b) sc))) a vc))
                              (list
                                (car x)
                                (- yt (cadr x))
                                (caddr x)
                                (- yt (cadddr x))
                                (last a)
                              )
                            )
                          )
                          vl
                        )
                      )
                    )
                    cache
                  )
                )
              )
              (cddr LM:BlockPreview)
            )
          )
          key block margin
        )
      )
    )
  )
 
  (defun RefGeom ( ename / elst ang norm mat )
    (setq elst (entget ename)
          ang  (cdr (assoc 50 elst))
          norm (cdr (assoc 210 elst))
    )
    (list
      (setq mat
        (mxm
          (mapcar '(lambda ( v ) (trans v 0 norm t))
            '(
               (1.0 0.0 0.0)
               (0.0 1.0 0.0)
               (0.0 0.0 1.0)
             )
           )
           (mxm
             (list
               (list (cos ang) (- (sin ang)) 0.0)
               (list (sin ang) (cos ang)     0.0)
              '(0.0 0.0 1.0)
             )
             (list
               (list (cdr (assoc 41 elst)) 0.0 0.0)
               (list 0.0 (cdr (assoc 42 elst)) 0.0)
               (list 0.0 0.0 (cdr (assoc 43 elst)))
             )
           )
        )
      )
      (mapcar '- (trans (cdr (assoc 10 elst)) norm 0)
          (mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst))))))
      )
    )
  )
 
  (defun LM:Entity->PointList ( ent / der di1 di2 di3 elst fun inc lst par rad )
    (setq elst (entget ent))
    (cond
      ( (eq "POINT" (cdr (assoc 0 elst)))
        (list (cdr (assoc 10 elst)))
      )
      ( (eq "LINE" (cdr (assoc 0 elst)))
        (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
      )
      ( (member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
        (setq di1 0.0
              di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
              inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
              fun (if (vlax-curve-isclosed ent) 
        )
        (while (fun di1 di2)
          (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                di1 (+ di1 inc)
          )
        )
        lst
      )
      ( (or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
            (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80)))
        )
        (setq par 0)
        (repeat (fix (1+ (vlax-curve-getendparam ent)))
          (if (setq der (vlax-curve-getsecondderiv ent par))
            (if (equal der '(0.0 0.0 0.0) 1e-8)
              (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
              (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
                        di1 (vlax-curve-getdistatparam ent par)
                        di2 (vlax-curve-getdistatparam ent (1+ par))
                  )
                (progn
                  (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
                  (while (
                    (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                          di1 (+ di1 inc)
                    )
                  )
                )
              )
            )
          )
          (setq par (1+ par))
        )
        (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-8))
          lst
          (cons (vlax-curve-getendpoint ent) lst)
        )
      )
      ( (eq (cdr (assoc 0 elst)) "ELLIPSE")
        (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
              di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
              di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))))
        )
        (while (
            (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                  der (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1)))
                  di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
            )
        )
        (if (vlax-curve-isclosed ent)
          lst
          (cons (vlax-curve-getendpoint ent) lst)
        )
      )
      ( (eq (cdr (assoc 0 elst)) "SPLINE")
        (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
              di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
              inc (/ di2 25.0)
        )
        (while (
          (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                di1 (+ di1 inc)
          )
        )
        (if (vlax-curve-isclosed ent)
          lst
          (cons (vlax-curve-getendpoint ent) lst)
        )
      )
    )
  )
 
  (defun trp ( m )
    (apply 'mapcar (cons 'list m))
  )
 
  (defun mxm ( m n )
    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
  )
 
  (defun mxv ( m v )
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  )
 
  (defun _blockpreview ( blk key )
    (start_image key)
    (fill_image 0 0 (dimx_tile key) (dimy_tile key) 0)
    (LM:BlockPreview key blk 5)
    (end_image)
  )
 
  (defun _blockpreview-highlight ( blk key / x0 y0 x y )
    (start_image key)
    (fill_image 0 0 (dimx_tile key) (dimy_tile key) 0)
    (LM:BlockPreview key blk 5)
    (setq x0 0 y0 0 x (dimx_tile key) y (dimy_tile key))
    (repeat 4
      (vector_image x0 y0 x y0 1)
      (vector_image x y0 x y 1)
      (vector_image x y x0 y 1)
      (vector_image x0 y x0 y0 1)
      (setq x0 (1+ x0) y0 (1+ y0) x (1- x) y (1- y))
    )
    (end_image)
  )
 
  (defun _ins ( bln )
    (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "_.-INSERT\n" bln "\n"))
  )
 
  (while (setq def (tblnext "BLOCK" (null def)))
    (if
      (and
        (= 0 (logand 125 (cdr (assoc 70 def))))
        (not (wcmatch (cdr (assoc 2 def)) "`_*,`**,*|*"))
      )
      (setq lst (cons (cdr (assoc 2 def)) lst))
    )
  )
 
  (cond
    ( (null (setq lst (vl-sort lst '
      (princ "\nNo blocks found in drawing.")
    )
    ( (null
        (and
          (setq tmp (vl-filename-mktemp nil nil ".dcl"))
          (setq des (open tmp "w"))
          (foreach line
           '(
              "blockpreview : dialog"
              "{"
              "    label = "Block Preview";"
              "    initial_focus = "lst";"
              "    spacer;"
              "    : row"
              "    {"
              "    : column"
              "    {"
              "        : list_box { key = "lst"; width = 30.0; fixed_width = true; }"
              "    }"
              "    : column"
              "    {"
            )
            (write-line line des)
          )
          (setq k 0)
          (setq q (fix (1+ (sqrt (- (length lst) 0.1)))))
          (repeat (expt q 2)
            (setq k (1+ k))
            (cond
              ( (= 1 q)
                (write-line " : row" des)
                (write-line " {" des)
                (foreach line
                  (list
                      "        : image"
                      "        {"
                      (strcat "            key = "img" (itoa k) "";")
                      (strcat "            width = " (rtos (* (/ q 2.0) (/ 100.0 (expt q 2))) 2 1) ";")
                      "            aspect_ratio = 1.0;"
                      "            fixed_width = true;"
                      "            fixed_height = true;"
                      "        }"
                  )
                  (write-line line des)
                )
                (write-line " }" des)
              )
              ( (= 0 (rem (1- k) q))
                (write-line " : row" des)
                (write-line " {" des)
                (foreach line
                  (list
                      "        : image"
                      "        {"
                      (strcat "            key = "img" (itoa k) "";")
                      (strcat "            width = " (rtos (* (/ q 2.0) (/ 100.0 (expt q 2))) 2 1) ";")
                      "            aspect_ratio = 1.0;"
                      "            fixed_width = true;"
                      "            fixed_height = true;"
                      "        }"
                  )
                  (write-line line des)
                )
              )
              ( (= (1- q) (rem (1- k) q))
                (foreach line
                  (list
                      "        : image"
                      "        {"
                      (strcat "            key = "img" (itoa k) "";")
                      (strcat "            width = " (rtos (* (/ q 2.0) (/ 100.0 (expt q 2))) 2 1) ";")
                      "            aspect_ratio = 1.0;"
                      "            fixed_width = true;"
                      "            fixed_height = true;"
                      "        }"
                  )
                  (write-line line des)
                )
                (write-line " }" des)
              )
              ( t
                (foreach line
                  (list
                      "        : image"
                      "        {"
                      (strcat "            key = "img" (itoa k) "";")
                      (strcat "            width = " (rtos (* (/ q 2.0) (/ 100.0 (expt q 2))) 2 1) ";")
                      "            aspect_ratio = 1.0;"
                      "            fixed_width = true;"
                      "            fixed_height = true;"
                      "        }"
                  )
                  (write-line line des)
                )
              )
            )
          )
          (foreach line
           '(
                "    }"
                "    }"
                "    spacer;"
                "    ok_cancel;"
                "}"
            )
            (write-line line des)
          )
          (not (setq des (close des)))
          (
          (new_dialog "blockpreview" dcl)
        )
      )
      (princ "\nUnable to load dialog.")
    )
    ( t
      (start_list "lst")
      (foreach x lst (add_list x))
      (end_list)
 
      (set_tile "lst" "0")
      (setq bln (nth 0 lst))
      (setq k 0)
      (foreach x lst
        (setq k (1+ k))
        (if (= k 1)
          (_blockpreview-highlight (nth 0 lst) "img1")
          (_blockpreview (nth (1- k) lst) (strcat "img" (itoa k)))
        )
      )
 
      (action_tile "lst" "(progn(setq k 0)(foreach x lst (setq k (1+ k))(_blockpreview (nth (1- k) lst) (strcat "img" (itoa k))))(_blockpreview-highlight (setq bln (nth (atoi $value) lst)) (strcat "img" (itoa (1+ (atoi $value))))))")
      (action_tile "accept" "(progn(_ins bln)(done_dialog 1))")
      (action_tile "cancel" "(done_dialog 0)")
      (start_dialog)
    )
  )
  (*error* nil)
)