« previous next »
Pages: [1] |   Go Down

Author Topic: Make Blocks explodable  (Read 3872 times)

0 Members and 1 Guest are viewing this topic.

Coder

  • Swamp Rat
  • Posts: 827
Make Blocks explodable
« on: January 28, 2015, 07:46:20 AM »
Hello guys .

I have lots of un-explodable blocks and I want to make them explodable , is this possible with lisp ?
manually I need to start block command and select the name of the block in the drop down list then check the option ALLOW EXPLODING then a message says redefine ? sure yes .

Many thanks in advance . :-)
Logged

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Make Blocks explodable
« Reply #1 on: January 28, 2015, 07:52:14 AM »
Logged
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

Coder

  • Swamp Rat
  • Posts: 827
Re: Make Blocks explodable
« Reply #2 on: January 28, 2015, 08:17:36 AM »
Logged

ROBBO

  • Bull Frog
  • Posts: 217
Re: Make Blocks explodable
« Reply #3 on: January 28, 2015, 09:13:19 AM »
ExplodeM - explode "unexplodable" MINSERT blocks, removes pseudo-protection of DWG drawings (VLX Lisp for AutoCAD):

http://www.cadforum.cz/cadforum_en/download.asp?file=ExplodeM%2Evlx
Logged
The only thing to do with good advice is to pass it on.
It is never of any use to oneself.

Oscar Wilde
(1854-1900, Irish playwright, poet and writer)

ScottMC

  • Newt
  • Posts: 191
Re: Make Blocks explodable
« Reply #4 on: October 19, 2017, 12:57:04 PM »
http://www.jefferypsanders.com/autolisp.html / Tip 2169 has XMInsert - explodes minsert-ed blocks for me!
« Last Edit: October 19, 2017, 01:13:03 PM by ScottMC »
Logged

ahsattarian

  • Newt
  • Posts: 112
Re: Make Blocks explodable
« Reply #5 on: August 04, 2021, 02:57:42 AM »
Try This   :   




Code - Auto/Visual Lisp: [Select]
  1. (defun c:explodem ()
  2.   (defun ren_blk (anonname / b_nam a_app a_doc a_blks i blk inspt cnt newfil ent bname bsel bndt bndx)
  3.     (setq b_nam (strcat "xmi" (substr (rtos (getvar "cdate") 2 24) 10)))
  4.     (setq a_app (vlax-get-acad-object))
  5.     (setq a_doc (vla-get-activedocument a_app))
  6.     (setq a_blks (vla-get-blocks a_doc))
  7.     (setq i 0)
  8.     (setq bname anonname)
  9.     (setq blk (vla-item a_blks bname))
  10.     (setq inspt (vla-get-origin blk))
  11.     (setq cnt (- (vla-get-count blk) 1))
  12.     (setq newfil (vlax-make-safearray vlax-vbobject (cons 0 cnt)))
  13.     (vlax-for ent blk (vlax-safearray-put-element newfil i ent) (setq i (1+ i)))
  14.     (if (null (tblsearch "block" b_nam))
  15.       (setq newblk (vla-add a_blks inspt b_nam))
  16.       (setq newblk (vla-add a_blks inspt (strcat b_nam "x")))
  17.     )
  18.     (vla-copyobjects a_doc newfil newblk nil)
  19.     (setq bsel (eval (selset)))
  20.     (cond
  21.       (bsel
  22.        (setq bndx 0)
  23.        (while (and (< bndx (sslength bsel)))
  24.          (setq bndt (entget (ssname bsel bndx)))
  25.          (setq bndt (subst (cons 2 b_nam) (assoc 2 bndt) bndt))
  26.          (setq bndt (subst (cons 70 0) (assoc 70 bndt) bndt))
  27.          (entmod bndt)
  28.          (setq bndx (1+ bndx))
  29.        )
  30.       )
  31.     )
  32.     b_nam
  33.   )
  34.   (defun selset (/ ent ss) (setq ent (entnext)) (setq ss (ssadd)) (command inspt) ss)
  35.   (defun repattval (en tagname newval)
  36.     (setq enlist (entget en))
  37.     (setq blkname (cdr (assoc 2 enlist)))
  38.     (cond ((= (substr blkname 1 1) "*") (ren_blk blkname)))
  39.     (cond
  40.       ((cdr (assoc 66 enlist))
  41.        (setq en (entnext en))
  42.        (setq enlist (entget en))
  43.        (setq blktype (strcase (cdr (assoc 0 enlist)) t))
  44.        (setq group66 (cdr (assoc 66 enlist)))
  45.        (while (and (or (= blktype "attrib") (= group66 1)))
  46.          (setq blktype (strcase (cdr (assoc 0 enlist)) t))
  47.          (setq entname (cdr (assoc 2 enlist)))
  48.          (cond
  49.            ((= blktype "attrib")
  50.             (setq atttag (cdr (assoc 2 enlist)))
  51.             (setq attval (cdr (assoc 1 enlist)))
  52.             (cond
  53.               ((= (strcase tagname) (strcase atttag))
  54.                (setq enlist (subst (cons 1 newval) (assoc 1 enlist) enlist))
  55.                (entmod enlist)
  56.                (entupd en)
  57.               )
  58.             )
  59.            )
  60.          )
  61.          (setq en (entnext en))
  62.          (setq enlist (entget en))
  63.          (setq blktype (strcase (cdr (assoc 0 enlist)) t))
  64.          (setq group66 (cdr (assoc 66 enlist)))
  65.        )
  66.       )
  67.     )
  68.   )
  69.   (defun getattdata (en / attlist attval enlist blktype group66)
  70.     (setq attlist (list))
  71.     (setq enlist (entget en))
  72.     (cond
  73.       ((cdr (assoc 66 enlist))
  74.        (setq en (entnext en))
  75.        (setq enlist (entget en))
  76.        (setq blktype (strcase (cdr (assoc 0 enlist)) t))
  77.        (setq group66 (cdr (assoc 66 enlist)))
  78.        (while (and (or (= blktype "attrib") (= group66 1)))
  79.          (setq blktype (strcase (cdr (assoc 0 enlist)) t))
  80.          (cond
  81.            ((= blktype "attrib")
  82.             (setq atttag (cdr (assoc 2 enlist)))
  83.             (setq attval (cdr (assoc 1 enlist)))
  84.             (setq attlist (append attlist (list (list atttag attval))))
  85.            )
  86.          )
  87.          (setq en (entnext en))
  88.          (setq enlist (entget en))
  89.          (setq blktype (strcase (cdr (assoc 0 enlist)) t))
  90.          (setq group66 (cdr (assoc 66 enlist)))
  91.        )
  92.       )
  93.     )
  94.     attlist
  95.   )
  96.   (cond
  97.     ((and
  98.        (setq ent (entsel "\n select minsert : "))
  99.        (setq en (car ent))
  100.        (= (strcase (cdr (assoc 0 (entget en))) t) "insert")
  101.      )
  102.      (setq origen en)
  103.      (setq enlist (entget en))
  104.      (setq blkname (cdr (assoc 2 enlist)))
  105.      (cond ((= (substr blkname 1 1) "*") (setq blkname (ren_blk blkname))))
  106.      (setq layname (cdr (assoc 8 enlist)))
  107.      (setq inspt (cdr (assoc 10 enlist)))
  108.      (setq cols (cdr (assoc 70 enlist)))
  109.      (setq rows (cdr (assoc 71 enlist)))
  110.      (setq colwidth (cdr (assoc 44 enlist)))
  111.      (setq rowwidth (cdr (assoc 45 enlist)))
  112.      (setq xscale (cdr (assoc 41 enlist)))
  113.      (setq yscale (cdr (assoc 42 enlist)))
  114.      (setq rangle (cdr (assoc 50 enlist)))
  115.      (cond ((assoc 66 enlist) (setq group66 (cdr (assoc 66 enlist)))))
  116.      (cond
  117.        ((= group66 1)
  118.         (setq oldattreq (getvar "attreq"))
  119.         (setvar "attreq" 0)
  120.         (setq attlist (getattdata en))
  121.        )
  122.      )
  123.      (command "._-insert")
  124.      (command blkname)
  125.      (command inspt)
  126.      (command xscale)
  127.      (command yscale)
  128.      (command (angtos rangle))
  129.      (cond ((= group66 1) (setvar "attreq" oldattreq)))
  130.      (cond
  131.        ((setq en (entlast))
  132.         (setq enlist (entget en))
  133.         (setq blkname2 (cdr (assoc 2 enlist)))
  134.         (cond
  135.           ((= blkname blkname2)
  136.            (cond
  137.              ((assoc 66 enlist)
  138.               (cond ((= (cdr (assoc 66 enlist)) 1) (foreach a attlist (repattval en (car a) (cadr a)))))
  139.              )
  140.            )
  141.            (entdel origen)
  142.            (if (and (or (> rows 1) (> cols 1)) (or (/= rowwidth 0) (/= colwidth 0)))
  143.              (progn
  144.                (command "_-array")
  145.                (command en)
  146.                (command "")
  147.                (command "_r")
  148.                (command rows)
  149.                (command cols)
  150.                (command rowwidth)
  151.                (command colwidth)
  152.              )
  153.              (progn
  154.                (initget "yes no")
  155.                (setq yes (getkword "\na single insert detected - explode? [no/yes] <yes>: "))
  156.                (cond ((/= yes "no") (command "._explode") (command (entlast)) (princ "\nexploded")))
  157.              )
  158.            )
  159.            (setq str (itoa (* rows cols)))
  160.            (princ (strcat "\n minsert replaced by : " str " blocks (can be exploded now)"))
  161.           )
  162.         )
  163.        )
  164.      )
  165.     )
  166.   )
  167.   (princ)
  168. )




Logged
Pages: [1] |   Go Up
« previous next »