Author Topic: Update the definition and all of its block references? - STOP ASKING ME THIS!!!!  (Read 253 times)

0 Members and 1 Guest are viewing this topic.

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16839
  • Superior Stupidity at its best
Maybe I am getting old (that has to be it) or maybe I am just too stupid to know what is going on.

I am being annoyed with a stupid popup every time I want to insert a block. "[block] is already defined. 432 block references already exist in the drawing. Update the definition and all of its block references?"

Um .. NO and I didn't want to be prompted 432 times already!

Expert is no help
BlockRedefineMode is no help

what the heck is going on?

Every time I enter a block name, it always wants to refer back to the file and insert from the drawing file and not from the block definition already in the drawing.

Someone please help me .. I am losing my mind over here!
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

ribarm

  • Water Moccasin
  • Posts: 2454
  • Marko Ribar, architect
Are you trying to redefine definitions and update insertions?
Is this happening when you insert block into DWG from DWG file?

If answer is yes, then I suggest that you collect all dwgs from folder where you gather all blocks for redefine and create script that will do INSERT command and always answer on question Yes/No as Yes...

If you already have definitions and you are just inserting them from DWG, then I also don't know what's going on - there should be no questions of any kind...

Some link...
https://www.cadtutor.net/forum/topic/71630-redefine-every-single-blocks-contained-in-a-drawing-from-block-library-folder-path/

Look at Mr. Lee Mac answer...
« Last Edit: December 31, 2020, 05:52:30 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16839
  • Superior Stupidity at its best
The blocks are already in the drawing ...
I am a keyboard commando most of the time, but I use the insert dialog ...

I simply type I [ENTER]
The GUI pops up
I type the name in the Name combo and press [ENTER]

NO!!!! I DO NOT WANT TO GET NOTIFIED!!! STOP IT!!!

I have literally inserted this block 432 times in this drawing give up already! If I haven't said yes in the last 432 times, why would I say yes on the 433 time?!

I dunno ... it didn't use to do this when I was able to use CAD on my Win 10 x64 PC ... before Autodesk refused to allow me to use my perfectly legitimate license on that PC .. so I am relegated to using it on my old Win 7 x64 PC because apparently they want me to purchase a subscription instead of a perpetual license.

ugh, I hate this company

Sorry for the rant! I've been working on these drawings all day and it is wearing on me!
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

Rustabout

  • Newt
  • Posts: 64
I've been having decent success with AutoCAD clones. But it takes some work to get used to them. You have to enjoy tinkering around with them let's say. And they come with their own unique set of frustrations.

I absolutely HATE AutoCAD's new 'insert' interface. I avoided the old one as well. I've always used the "-insert" command when I had the name of the block memorized. For frequently inserted blocks I would make a basic LISP. Or Macro when forced to use AutoCAD LT. I was able to get surprisingly fast performance out of AutoCAD LT by configuring a really slick Ribbon panel setup.

Give the "-insert" command a whirl and see if it still prompts you.

ribarm

  • Water Moccasin
  • Posts: 2454
  • Marko Ribar, architect
Keith, give this lisp a try... I know, dialog box gives a preview of blocks without showing attributes, but it uses (vla-sendcommand) to finally insert block you choose... It was me that mod. Mr. Lee's BlockPreview DCL example, but I use it very well... I think that it may be helpful and to you...
Regards, M.R.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:binsert ( / *error* LM:BlockPreview RefGeom LM:Entity->PointList trp mxm mxv _blockpreview _ins dcl def des lst tmp bln )
  2.  
  3.     (vl-load-com)
  4.  
  5.     (defun *error* ( msg )
  6.         (if (< 0 dcl)
  7.             (unload_dialog dcl)
  8.         )
  9.         (if (= 'file (type des))
  10.             (close des)
  11.         )
  12.         (if (and tmp (findfile tmp))
  13.             (vl-file-delete tmp)
  14.         )
  15.         (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
  16.             (princ (strcat "\nError: " msg))
  17.         )
  18.         (princ)
  19.     )
  20.  
  21.     (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 )
  22.         (setq cache '( ))
  23.  
  24.         (defun _getcolour ( l / c )
  25.             (cond
  26.                 (   (= 0 (setq c (cdr (assoc 62 l))))
  27.                     7
  28.                 )
  29.                 (   (or (null c) (= 256 c))
  30.                     (abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 l))))))
  31.                 )
  32.                 (   c   )
  33.             )
  34.         )
  35.  
  36.         (defun _getvectors ( bn / ec el en pl rg vl )
  37.             (if (setq en (tblobjname "BLOCK" bn))
  38.                 (while (setq en (entnext en))
  39.                     (setq el (entget en))
  40.                     (cond
  41.                         (   (= 1 (cdr (assoc 60 el))))
  42.                         (   (= "INSERT" (cdr (assoc 0 el)))
  43.                             (setq rg (RefGeom en))
  44.                             (setq vl
  45.                                 (append vl
  46.                                     (mapcar
  47.                                         (function
  48.                                             (lambda ( x )
  49.                                                 (append
  50.                                                     (mapcar '+ (mxv (car rg) (list (car   x) (cadr   x) 0.0)) '(0 0) (cadr rg))
  51.                                                     (mapcar '+ (mxv (car rg) (list (caddr x) (cadddr x) 0.0)) '(0 0) (cadr rg))
  52.                                                     (cddddr x)
  53.                                                 )
  54.                                             )
  55.                                         )
  56.                                         (_getvectors (cdr (assoc 2 el)))
  57.                                     )
  58.                                 )
  59.                             )
  60.                         )
  61.                         (   (setq pl (LM:Entity->PointList en))
  62.                             (if (or (= "POINT" (cdr (assoc 0 el))) (vlax-curve-isclosed en))
  63.                                 (setq pl (cons (last pl) pl))
  64.                             )
  65.                             (setq ec (_getcolour el))
  66.                             (setq vl
  67.                                 (append vl
  68.                                     (mapcar
  69.                                         (function
  70.                                             (lambda ( a b )
  71.                                                 (list (car a) (cadr a) (car b) (cadr b) ec)
  72.                                             )
  73.                                         )
  74.                                         pl (cdr pl)
  75.                                     )
  76.                                 )
  77.                             )
  78.                         )
  79.                     )
  80.                 )
  81.             )
  82.             vl
  83.         )
  84.  
  85.         (defun _unique ( l / a r )
  86.             (while (setq a (car l))
  87.                 (setq r (cons a r)
  88.                       l (vl-remove-if (function (lambda ( b ) (equal a b))) (cdr l))
  89.                 )
  90.             )
  91.             (reverse r)
  92.         )
  93.  
  94.         (cond
  95.             (   (or (< margin 0)
  96.                     (<= (setq xt (dimx_tile key)) (* 2 margin))
  97.                     (<= (setq yt (dimy_tile key)) (* 2 margin))
  98.                 )
  99.                 nil
  100.             )
  101.             (   (setq vl (assoc (strcase block) cache))
  102.                 (foreach x (cdr vl) (apply 'vector_image x))
  103.                 t
  104.             )            
  105.             (   (setq vl (_getvectors block))
  106.                 (setq mi (apply 'mapcar (cons 'min vl))
  107.                       mx (apply 'mapcar (cons 'max vl))
  108.                       mi (list (min (car mi) (caddr mi)) (min (cadr mi) (cadddr mi)))
  109.                       mx (list (max (car mx) (caddr mx)) (max (cadr mx) (cadddr mx)))
  110.                       r1 (/ (- (car  mx) (car  mi)) (- xt (* 2 margin)))
  111.                       r2 (/ (- (cadr mx) (cadr mi)) (- yt (* 2 margin)))
  112.                 )
  113.                 (cond
  114.                     (   (and (equal r1 r2 1e-8) (equal r1 0.0 1e-8))
  115.                         (setq sc 1.0
  116.                               vc (mapcar '- mi (list (/ xt 2.0) (/ yt 2.0)))
  117.                         )
  118.                     )
  119.                     (   (equal r1 r2 1e-8)
  120.                         (setq sc r1
  121.                               vc (mapcar '(lambda ( x ) (- x (* sc margin))) mi)
  122.                         )
  123.                     )
  124.                     (   (< r1 r2)
  125.                         (setq sc r2)
  126.                         (setq vc
  127.                             (list
  128.                                 (- (car  mi) (/ (- (* sc xt) (- (car mx) (car mi))) 2.0))
  129.                                 (- (cadr mi) (* sc margin))
  130.                             )
  131.                         )
  132.                     )
  133.                     (   t
  134.                         (setq sc r1)
  135.                         (setq vc
  136.                             (list
  137.                                 (- (car  mi) (* sc margin))
  138.                                 (- (cadr mi) (/ (- (* sc yt) (- (cadr mx) (cadr mi))) 2.0))
  139.                             )
  140.                         )
  141.                     )
  142.                 )
  143.                 (setq vc (append vc vc))
  144.                 (   (setq LM:BlockPreview
  145.                         (vl-list* '( key block margin )
  146.                              (list 'setq 'cache
  147.                                  (list 'quote
  148.                                      (cons
  149.                                          (cons (strcase block)
  150.                                              (_unique
  151.                                                  (mapcar
  152.                                                      (function
  153.                                                          (lambda ( a / x )
  154.                                                              (setq x (mapcar '(lambda ( a b ) (fix (/ (- a b) sc))) a vc))
  155.                                                              (list
  156.                                                                  (car x)
  157.                                                                  (- yt (cadr x))
  158.                                                                  (caddr x)
  159.                                                                  (- yt (cadddr x))
  160.                                                                  (last a)
  161.                                                              )
  162.                                                          )
  163.                                                      )
  164.                                                      vl
  165.                                                  )
  166.                                              )
  167.                                          )
  168.                                          cache
  169.                                      )
  170.                                  )
  171.                              )
  172.                              (cddr LM:BlockPreview)
  173.                         )
  174.                     )
  175.                     key block margin
  176.                 )
  177.             )
  178.         )
  179.     )
  180.  
  181.     (defun RefGeom ( ename / elst ang norm mat )
  182.         (setq elst (entget ename)
  183.               ang  (cdr (assoc 50 elst))
  184.               norm (cdr (assoc 210 elst))
  185.         )
  186.         (list
  187.             (setq mat
  188.                 (mxm
  189.                     (mapcar '(lambda ( v ) (trans v 0 norm t))
  190.                        '(
  191.                             (1.0 0.0 0.0)
  192.                             (0.0 1.0 0.0)
  193.                             (0.0 0.0 1.0)
  194.                         )
  195.                     )
  196.                     (mxm
  197.                         (list
  198.                             (list (cos ang) (- (sin ang)) 0.0)
  199.                             (list (sin ang) (cos ang)     0.0)
  200.                            '(0.0 0.0 1.0)
  201.                         )
  202.                         (list
  203.                             (list (cdr (assoc 41 elst)) 0.0 0.0)
  204.                             (list 0.0 (cdr (assoc 42 elst)) 0.0)
  205.                             (list 0.0 0.0 (cdr (assoc 43 elst)))
  206.                         )
  207.                     )
  208.                 )
  209.             )
  210.             (mapcar '- (trans (cdr (assoc 10 elst)) norm 0)
  211.                 (mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst))))))
  212.             )
  213.         )
  214.     )
  215.  
  216.     (defun LM:Entity->PointList ( ent / der di1 di2 di3 elst fun inc lst par rad )
  217.         (setq elst (entget ent))
  218.         (cond
  219.             (   (eq "POINT" (cdr (assoc 0 elst)))
  220.                 (list (cdr (assoc 10 elst)))
  221.             )
  222.             (   (eq "LINE" (cdr (assoc 0 elst)))
  223.                 (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
  224.             )
  225.             (   (member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
  226.                 (setq di1 0.0
  227.                       di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
  228.                       inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
  229.                       fun (if (vlax-curve-isclosed ent) < <=)
  230.                 )
  231.                 (while (fun di1 di2)
  232.                     (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  233.                           di1 (+ di1 inc)
  234.                     )
  235.                 )
  236.                 lst
  237.             )
  238.             (   (or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
  239.                     (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80)))
  240.                 )
  241.                 (setq par 0)
  242.                 (repeat (fix (1+ (vlax-curve-getendparam ent)))
  243.                     (if (setq der (vlax-curve-getsecondderiv ent par))
  244.                         (if (equal der '(0.0 0.0 0.0) 1e-8)
  245.                             (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
  246.                             (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
  247.                                       di1 (vlax-curve-getdistatparam ent par)
  248.                                       di2 (vlax-curve-getdistatparam ent (1+ par))
  249.                                 )
  250.                                 (progn
  251.                                     (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
  252.                                     (while (< di1 di2)
  253.                                         (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  254.                                               di1 (+ di1 inc)
  255.                                         )
  256.                                     )
  257.                                 )
  258.                             )
  259.                         )
  260.                     )
  261.                     (setq par (1+ par))
  262.                 )
  263.                 (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-8))
  264.                     lst
  265.                     (cons (vlax-curve-getendpoint ent) lst)
  266.                 )
  267.             )
  268.             (   (eq (cdr (assoc 0 elst)) "ELLIPSE")
  269.                 (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
  270.                       di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  271.                       di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))))
  272.                 )
  273.                 (while (< di1 di2)
  274.                     (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  275.                           der (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1)))
  276.                           di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
  277.                     )
  278.                 )
  279.                 (if (vlax-curve-isclosed ent)
  280.                     lst
  281.                     (cons (vlax-curve-getendpoint ent) lst)
  282.                 )
  283.             )
  284.             (   (eq (cdr (assoc 0 elst)) "SPLINE")
  285.                 (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
  286.                       di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  287.                       inc (/ di2 25.0)
  288.                 )
  289.                 (while (< di1 di2)
  290.                     (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  291.                           di1 (+ di1 inc)
  292.                     )
  293.                 )
  294.                 (if (vlax-curve-isclosed ent)
  295.                     lst
  296.                     (cons (vlax-curve-getendpoint ent) lst)
  297.                 )
  298.             )
  299.         )
  300.     )
  301.  
  302.     (defun trp ( m )
  303.         (apply 'mapcar (cons 'list m))
  304.     )
  305.  
  306.     (defun mxm ( m n )
  307.         ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
  308.     )
  309.  
  310.     (defun mxv ( m v )
  311.         (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  312.     )
  313.  
  314.     (defun _blockpreview ( blk )
  315.         (start_image "img")
  316.         (fill_image 0 0 (dimx_tile "img") (dimy_tile "img") 0)
  317.         (LM:BlockPreview "img" blk 5)
  318.         (end_image)
  319.     )
  320.  
  321.     (defun _ins ( bln )
  322.         (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "_.-INSERT\n" bln "\n"))
  323.     )
  324.  
  325.     (while (setq def (tblnext "BLOCK" (null def)))
  326.         (if
  327.             (and
  328.                 (= 0 (logand 125 (cdr (assoc 70 def))))
  329.                 (not (wcmatch (cdr (assoc 2 def)) "`_*,`**,*|*"))
  330.             )
  331.             (setq lst (cons (cdr (assoc 2 def)) lst))
  332.         )
  333.     )
  334.  
  335.     (cond
  336.         (   (null (setq lst (vl-sort lst '<)))
  337.             (princ "\nNo blocks found in drawing.")
  338.         )
  339.         (   (null
  340.                 (and
  341.                     (setq tmp (vl-filename-mktemp nil nil ".dcl"))
  342.                     (setq des (open tmp "w"))
  343.                     (foreach line
  344.                        '(
  345.                             "blockpreview : dialog"
  346.                             "{"
  347.                             "    label = \"Block Preview\";"
  348.                             "    initial_focus = \"lst\";"
  349.                             "    spacer;"
  350.                             "    : row"
  351.                             "    {"
  352.                             "        : list_box { key = \"lst\"; width = 30.0; fixed_width = true; }"
  353.                             "        spacer;"
  354.                             "        : image"
  355.                             "        {"
  356.                             "            key = \"img\";"
  357.                             "            width = 33.5;"
  358.                             "            aspect_ratio = 1.0;"
  359.                             "            fixed_width = true;"
  360.                             "            fixed_height = true;"
  361.                             "        }"
  362.                             "    }"
  363.                             "    spacer;"
  364.                             "    ok_cancel;"
  365.                             "}"
  366.                         )
  367.                         (write-line line des)
  368.                     )
  369.                     (not (setq des (close des)))
  370.                     (< 0 (setq dcl (load_dialog tmp)))
  371.                     (new_dialog "blockpreview" dcl)
  372.                 )
  373.             )
  374.             (princ "\nUnable to load dialog.")
  375.         )
  376.         (   t
  377.             (start_list "lst")
  378.             (foreach x lst (add_list x))
  379.             (end_list)
  380.  
  381.             (set_tile "lst" "0")
  382.             (setq bln (nth 0 lst))
  383.             (_blockpreview (car lst))
  384.  
  385.             (action_tile "lst" "(_blockpreview (setq bln (nth (atoi $value) lst)))")
  386.             (action_tile "accept" "(progn(_ins bln)(done_dialog 1))")
  387.             (action_tile "cancel" "(done_dialog 0)")
  388.             (start_dialog)
  389.         )
  390.     )
  391.     (*error* nil)
  392. )
  393.  
« Last Edit: January 01, 2021, 04:04:05 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2454
  • Marko Ribar, architect
Code - Auto/Visual Lisp: [Select]
  1. (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 )
  2.  
  3.  
  4.   (defun *error* ( msg )
  5.     (if (< 0 dcl)
  6.       (unload_dialog dcl)
  7.     )
  8.     (if (= 'file (type des))
  9.       (close des)
  10.     )
  11.     (if (and tmp (findfile tmp))
  12.       (vl-file-delete tmp)
  13.     )
  14.     (if (and msg (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")))
  15.       (princ (strcat "\nError: " msg))
  16.     )
  17.     (princ)
  18.   )
  19.  
  20.   (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 )
  21.     (setq cache '( ))
  22.  
  23.     (defun _getcolour ( l / c )
  24.       (cond
  25.         ( (= 0 (setq c (cdr (assoc 62 l))))
  26.           7
  27.         )
  28.         ( (or (null c) (= 256 c))
  29.           (abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 l))))))
  30.         )
  31.         ( c )
  32.       )
  33.     )
  34.  
  35.     (defun _getvectors ( bn / ec el en pl rg vl )
  36.       (if (setq en (tblobjname "BLOCK" bn))
  37.         (while (setq en (entnext en))
  38.           (setq el (entget en))
  39.           (cond
  40.             ( (= 1 (cdr (assoc 60 el))))
  41.             ( (= "INSERT" (cdr (assoc 0 el)))
  42.               (setq rg (RefGeom en))
  43.               (setq vl
  44.                 (append vl
  45.                   (mapcar
  46.                     (function
  47.                       (lambda ( x )
  48.                         (append
  49.                           (mapcar '+ (mxv (car rg) (list (car   x) (cadr   x) 0.0)) '(0 0) (cadr rg))
  50.                           (mapcar '+ (mxv (car rg) (list (caddr x) (cadddr x) 0.0)) '(0 0) (cadr rg))
  51.                           (cddddr x)
  52.                         )
  53.                       )
  54.                     )
  55.                     (_getvectors (cdr (assoc 2 el)))
  56.                   )
  57.                 )
  58.               )
  59.             )
  60.             ( (setq pl (LM:Entity->PointList en))
  61.               (if (or (= "POINT" (cdr (assoc 0 el))) (vlax-curve-isclosed en))
  62.                 (setq pl (cons (last pl) pl))
  63.               )
  64.               (setq ec (_getcolour el))
  65.               (setq vl
  66.                 (append vl
  67.                   (mapcar
  68.                     (function
  69.                       (lambda ( a b )
  70.                         (list (car a) (cadr a) (car b) (cadr b) ec)
  71.                       )
  72.                     )
  73.                     pl (cdr pl)
  74.                   )
  75.                 )
  76.               )
  77.             )
  78.           )
  79.         )
  80.       )
  81.       vl
  82.     )
  83.  
  84.     (defun _unique ( l / a r )
  85.       (while (setq a (car l))
  86.         (setq r (cons a r)
  87.               l (vl-remove-if (function (lambda ( b ) (equal a b))) (cdr l))
  88.         )
  89.       )
  90.       (reverse r)
  91.     )
  92.  
  93.     (cond
  94.       ( (or (< margin 0)
  95.           (<= (setq xt (dimx_tile key)) (* 2 margin))
  96.           (<= (setq yt (dimy_tile key)) (* 2 margin))
  97.         )
  98.         nil
  99.       )
  100.       ( (setq vl (assoc (strcase block) cache))
  101.         (foreach x (cdr vl) (apply 'vector_image x))
  102.         t
  103.       )            
  104.       ( (setq vl (_getvectors block))
  105.         (setq mi (apply 'mapcar (cons 'min vl))
  106.               mx (apply 'mapcar (cons 'max vl))
  107.               mi (list (min (car mi) (caddr mi)) (min (cadr mi) (cadddr mi)))
  108.               mx (list (max (car mx) (caddr mx)) (max (cadr mx) (cadddr mx)))
  109.               r1 (/ (- (car  mx) (car  mi)) (- xt (* 2 margin)))
  110.               r2 (/ (- (cadr mx) (cadr mi)) (- yt (* 2 margin)))
  111.         )
  112.         (cond
  113.           ( (and (equal r1 r2 1e-8) (equal r1 0.0 1e-8))
  114.             (setq sc 1.0
  115.                   vc (mapcar '- mi (list (/ xt 2.0) (/ yt 2.0)))
  116.             )
  117.           )
  118.           ( (equal r1 r2 1e-8)
  119.             (setq sc r1
  120.                   vc (mapcar '(lambda ( x ) (- x (* sc margin))) mi)
  121.             )
  122.           )
  123.           ( (< r1 r2)
  124.             (setq sc r2)
  125.             (setq vc
  126.               (list
  127.                 (- (car  mi) (/ (- (* sc xt) (- (car mx) (car mi))) 2.0))
  128.                 (- (cadr mi) (* sc margin))
  129.               )
  130.             )
  131.           )
  132.           ( t
  133.             (setq sc r1)
  134.             (setq vc
  135.               (list
  136.                 (- (car  mi) (* sc margin))
  137.                 (- (cadr mi) (/ (- (* sc yt) (- (cadr mx) (cadr mi))) 2.0))
  138.               )
  139.             )
  140.           )
  141.         )
  142.         (setq vc (append vc vc))
  143.         ( (setq LM:BlockPreview
  144.             (vl-list* '( key block margin )
  145.               (list 'setq 'cache
  146.                 (list 'quote
  147.                   (cons
  148.                     (cons (strcase block)
  149.                       (_unique
  150.                         (mapcar
  151.                           (function
  152.                             (lambda ( a / x )
  153.                               (setq x (mapcar '(lambda ( a b ) (fix (/ (- a b) sc))) a vc))
  154.                               (list
  155.                                 (car x)
  156.                                 (- yt (cadr x))
  157.                                 (caddr x)
  158.                                 (- yt (cadddr x))
  159.                                 (last a)
  160.                               )
  161.                             )
  162.                           )
  163.                           vl
  164.                         )
  165.                       )
  166.                     )
  167.                     cache
  168.                   )
  169.                 )
  170.               )
  171.               (cddr LM:BlockPreview)
  172.             )
  173.           )
  174.           key block margin
  175.         )
  176.       )
  177.     )
  178.   )
  179.  
  180.   (defun RefGeom ( ename / elst ang norm mat )
  181.     (setq elst (entget ename)
  182.           ang  (cdr (assoc 50 elst))
  183.           norm (cdr (assoc 210 elst))
  184.     )
  185.     (list
  186.       (setq mat
  187.         (mxm
  188.           (mapcar '(lambda ( v ) (trans v 0 norm t))
  189.             '(
  190.                (1.0 0.0 0.0)
  191.                (0.0 1.0 0.0)
  192.                (0.0 0.0 1.0)
  193.              )
  194.            )
  195.            (mxm
  196.              (list
  197.                (list (cos ang) (- (sin ang)) 0.0)
  198.                (list (sin ang) (cos ang)     0.0)
  199.               '(0.0 0.0 1.0)
  200.              )
  201.              (list
  202.                (list (cdr (assoc 41 elst)) 0.0 0.0)
  203.                (list 0.0 (cdr (assoc 42 elst)) 0.0)
  204.                (list 0.0 0.0 (cdr (assoc 43 elst)))
  205.              )
  206.            )
  207.         )
  208.       )
  209.       (mapcar '- (trans (cdr (assoc 10 elst)) norm 0)
  210.           (mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 elst))))))
  211.       )
  212.     )
  213.   )
  214.  
  215.   (defun LM:Entity->PointList ( ent / der di1 di2 di3 elst fun inc lst par rad )
  216.     (setq elst (entget ent))
  217.     (cond
  218.       ( (eq "POINT" (cdr (assoc 0 elst)))
  219.         (list (cdr (assoc 10 elst)))
  220.       )
  221.       ( (eq "LINE" (cdr (assoc 0 elst)))
  222.         (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
  223.       )
  224.       ( (member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
  225.         (setq di1 0.0
  226.               di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
  227.               inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
  228.               fun (if (vlax-curve-isclosed ent) < <=)
  229.         )
  230.         (while (fun di1 di2)
  231.           (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  232.                 di1 (+ di1 inc)
  233.           )
  234.         )
  235.         lst
  236.       )
  237.       ( (or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
  238.             (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80)))
  239.         )
  240.         (setq par 0)
  241.         (repeat (fix (1+ (vlax-curve-getendparam ent)))
  242.           (if (setq der (vlax-curve-getsecondderiv ent par))
  243.             (if (equal der '(0.0 0.0 0.0) 1e-8)
  244.               (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
  245.               (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
  246.                         di1 (vlax-curve-getdistatparam ent par)
  247.                         di2 (vlax-curve-getdistatparam ent (1+ par))
  248.                   )
  249.                 (progn
  250.                   (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
  251.                   (while (< di1 di2)
  252.                     (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  253.                           di1 (+ di1 inc)
  254.                     )
  255.                   )
  256.                 )
  257.               )
  258.             )
  259.           )
  260.           (setq par (1+ par))
  261.         )
  262.         (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-8))
  263.           lst
  264.           (cons (vlax-curve-getendpoint ent) lst)
  265.         )
  266.       )
  267.       ( (eq (cdr (assoc 0 elst)) "ELLIPSE")
  268.               di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  269.               di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))))
  270.         )
  271.         (while (< di1 di2)
  272.             (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  273.                   der (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1)))
  274.                   di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
  275.             )
  276.         )
  277.         (if (vlax-curve-isclosed ent)
  278.           lst
  279.           (cons (vlax-curve-getendpoint ent) lst)
  280.         )
  281.       )
  282.       ( (eq (cdr (assoc 0 elst)) "SPLINE")
  283.               di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent))
  284.               inc (/ di2 25.0)
  285.         )
  286.         (while (< di1 di2)
  287.           (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
  288.                 di1 (+ di1 inc)
  289.           )
  290.         )
  291.         (if (vlax-curve-isclosed ent)
  292.           lst
  293.           (cons (vlax-curve-getendpoint ent) lst)
  294.         )
  295.       )
  296.     )
  297.   )
  298.  
  299.   (defun trp ( m )
  300.     (apply 'mapcar (cons 'list m))
  301.   )
  302.  
  303.   (defun mxm ( m n )
  304.     ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
  305.   )
  306.  
  307.   (defun mxv ( m v )
  308.     (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  309.   )
  310.  
  311.   (defun _blockpreview ( blk key )
  312.     (start_image key)
  313.     (fill_image 0 0 (dimx_tile key) (dimy_tile key) 0)
  314.     (LM:BlockPreview key blk 5)
  315.     (end_image)
  316.   )
  317.  
  318.   (defun _blockpreview-highlight ( blk key / x0 y0 x y )
  319.     (start_image key)
  320.     (fill_image 0 0 (dimx_tile key) (dimy_tile key) 0)
  321.     (LM:BlockPreview key blk 5)
  322.     (setq x0 0 y0 0 x (dimx_tile key) y (dimy_tile key))
  323.     (repeat 4
  324.       (vector_image x0 y0 x y0 1)
  325.       (vector_image x y0 x y 1)
  326.       (vector_image x y x0 y 1)
  327.       (vector_image x0 y x0 y0 1)
  328.       (setq x0 (1+ x0) y0 (1+ y0) x (1- x) y (1- y))
  329.     )
  330.     (end_image)
  331.   )
  332.  
  333.   (defun _ins ( bln )
  334.   )
  335.  
  336.   (while (setq def (tblnext "BLOCK" (null def)))
  337.     (if
  338.       (and
  339.         (= 0 (logand 125 (cdr (assoc 70 def))))
  340.         (not (wcmatch (cdr (assoc 2 def)) "`_*,`**,*|*"))
  341.       )
  342.       (setq lst (cons (cdr (assoc 2 def)) lst))
  343.     )
  344.   )
  345.  
  346.   (cond
  347.     ( (null (setq lst (vl-sort lst '<)))
  348.       (princ "\nNo blocks found in drawing.")
  349.     )
  350.     ( (null
  351.         (and
  352.           (setq tmp (vl-filename-mktemp nil nil ".dcl"))
  353.           (setq des (open tmp "w"))
  354.           (foreach line
  355.            '(
  356.               "blockpreview : dialog"
  357.               "{"
  358.               "    label = \"Block Preview\";"
  359.               "    initial_focus = \"lst\";"
  360.               "    spacer;"
  361.               "    : row"
  362.               "    {"
  363.               "    : column"
  364.               "    {"
  365.               "        : list_box { key = \"lst\"; width = 30.0; fixed_width = true; }"
  366.               "    }"
  367.               "    : column"
  368.               "    {"
  369.             )
  370.             (write-line line des)
  371.           )
  372.           (setq k 0)
  373.           (setq q (fix (1+ (sqrt (- (length lst) 0.1)))))
  374.           (repeat (expt q 2)
  375.             (setq k (1+ k))
  376.             (cond
  377.               ( (= 1 q)
  378.                 (write-line " : row" des)
  379.                 (write-line " {" des)
  380.                 (foreach line
  381.                   (list
  382.                       "        : image"
  383.                       "        {"
  384.                       (strcat "            key = \"img" (itoa k) "\";")
  385.                       (strcat "            width = " (rtos (* (/ q 2.0) (/ 100.0 (expt q 2))) 2 1) ";")
  386.                       "            aspect_ratio = 1.0;"
  387.                       "            fixed_width = true;"
  388.                       "            fixed_height = true;"
  389.                       "        }"
  390.                   )
  391.                   (write-line line des)
  392.                 )
  393.                 (write-line " }" des)
  394.               )
  395.               ( (= 0 (rem (1- k) q))
  396.                 (write-line " : row" des)
  397.                 (write-line " {" des)
  398.                 (foreach line
  399.                   (list
  400.                       "        : image"
  401.                       "        {"
  402.                       (strcat "            key = \"img" (itoa k) "\";")
  403.                       (strcat "            width = " (rtos (* (/ q 2.0) (/ 100.0 (expt q 2))) 2 1) ";")
  404.                       "            aspect_ratio = 1.0;"
  405.                       "            fixed_width = true;"
  406.                       "            fixed_height = true;"
  407.                       "        }"
  408.                   )
  409.                   (write-line line des)
  410.                 )
  411.               )
  412.               ( (= (1- q) (rem (1- k) q))
  413.                 (foreach line
  414.                   (list
  415.                       "        : image"
  416.                       "        {"
  417.                       (strcat "            key = \"img" (itoa k) "\";")
  418.                       (strcat "            width = " (rtos (* (/ q 2.0) (/ 100.0 (expt q 2))) 2 1) ";")
  419.                       "            aspect_ratio = 1.0;"
  420.                       "            fixed_width = true;"
  421.                       "            fixed_height = true;"
  422.                       "        }"
  423.                   )
  424.                   (write-line line des)
  425.                 )
  426.                 (write-line " }" des)
  427.               )
  428.               ( t
  429.                 (foreach line
  430.                   (list
  431.                       "        : image"
  432.                       "        {"
  433.                       (strcat "            key = \"img" (itoa k) "\";")
  434.                       (strcat "            width = " (rtos (* (/ q 2.0) (/ 100.0 (expt q 2))) 2 1) ";")
  435.                       "            aspect_ratio = 1.0;"
  436.                       "            fixed_width = true;"
  437.                       "            fixed_height = true;"
  438.                       "        }"
  439.                   )
  440.                   (write-line line des)
  441.                 )
  442.               )
  443.             )
  444.           )
  445.           (foreach line
  446.            '(
  447.                 "    }"
  448.                 "    }"
  449.                 "    spacer;"
  450.                 "    ok_cancel;"
  451.                 "}"
  452.             )
  453.             (write-line line des)
  454.           )
  455.           (not (setq des (close des)))
  456.           (< 0 (setq dcl (load_dialog tmp)))
  457.           (new_dialog "blockpreview" dcl)
  458.         )
  459.       )
  460.       (princ "\nUnable to load dialog.")
  461.     )
  462.     ( t
  463.       (start_list "lst")
  464.       (foreach x lst (add_list x))
  465.       (end_list)
  466.  
  467.       (set_tile "lst" "0")
  468.       (setq bln (nth 0 lst))
  469.       (setq k 0)
  470.       (foreach x lst
  471.         (setq k (1+ k))
  472.         (if (= k 1)
  473.           (_blockpreview-highlight (nth 0 lst) "img1")
  474.           (_blockpreview (nth (1- k) lst) (strcat "img" (itoa k)))
  475.         )
  476.       )
  477.  
  478.       (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))))))")
  479.       (action_tile "accept" "(progn(_ins bln)(done_dialog 1))")
  480.       (action_tile "cancel" "(done_dialog 0)")
  481.       (start_dialog)
  482.     )
  483.   )
  484.   (*error* nil)
  485. )
  486.  
« Last Edit: January 01, 2021, 04:03:33 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2454
  • Marko Ribar, architect
Just another way...
Start "AutoCAD Design Center" - command ADC...
Go to blocks - it will cache data and you'll have preview of all blocks in DWG - it will be real thumbnails not as with Lee's Block Preview only curves... So this is better... You can then double click on block you wish to insert and there you go...
It's all built-in...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube