Grab block from one drawing and insert into another via a lisp

April 13, 2018

Hi All,

Not sure if this is possible but I'm looking for a way to grab a block that is a block in one drawing and insert it into another drawing via a lisp function

The scenario is that i have a drawing that is a "master" drawing. It has all of our blocks, line types etc. in it. so I want a way that will only grab the block i want and insert into my active drawing.

Thanks

Mark

April 13, 2018

Don't want to use tool pallettes? That is essentially what they do in an easy to use graphical format.

This is possible to do in a myriad of ways though.

Thanks.

Sent from my Pixel 2 XL using Tapatalk

April 13, 2018

Sounds like Lee Mac has got you covered, as usual,

http://www.lee-mac.com/steal.html

Thanks Lee!

I have never used this one, but I believe it will do exactly what you are describing.

April 13, 2018

Steal is a great program. I use it extensively in my setup.

Sent from my Pixel 2 XL using Tapatalk

April 13, 2018

Thanks guys,

Yes i do use "steal" a fair bit, but i can get it to go straight to the "Master" drawing it only goes to the folder containing the "master" drawing.

I have on occasion the tool pallettes but when you have about 100 block, it takes it's to much time to read all the block etc. every time you open a drawing....too clunky!!

I'm still looking for one that will just extract a certain commonly used block so that i can have a short cut insert command for it.

Thanks Again,

MC

April 13, 2018

It looks like there are some available options, like StealLast , which could directly access the MASTER dwg, as opposed to accessing the folder.

Also SubFunctions described might be useful. Take a good look at the description Lee wrote for the various ways to use the lisp. In one of those you merely specify the drawing name in the code, if that is always where you want to access your blocks.

It looks like the direct entry Search box might save you a little time, compared to looking through all the blocks, at the bottom of the dialog box..

April 13, 2018

;;--------------=={ Copy Block From Drawing }==---------------;;
;;                                                            ;;
;;  Copies the selected block definition from the selected    ;;
;;  drawing to the ActiveDocument using a deep clone          ;;
;;  operation.                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
(defun c:cb (/     *error*   acapp  acdoc acblk  spc    dwg
     dbxDoc lst    dcfname  file dc     ptr    fl
     pt     norm   block
    )
 (vl-load-com)
 ;; © Lee Mac 2010
 (defun *error* (msg)
   (vl-catch-all-apply
     '(lambda nil
 (if dbxDoc
   (vlax-release-object dbxDoc)
 )
 (if (and file (eq 'FILE (type file)))
   (setq file (close file))
 )
 (if (and dcfname (setq dcfname (findfile dcfname)))
   (vl-file-delete dcfname)
 )
 (if dc
   (unload_dialog dc)
 )
      )
   )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (setq acapp (vlax-get-acad-object)
acdoc (vla-get-ActiveDocument acapp)
acblk (vla-get-Blocks acdoc)
 )
 (setq spc
 (if
   (or (eq AcModelSpace (vla-get-ActiveSpace acdoc))
       (eq :vlax-true (vla-get-MSpace acdoc))
   )
    (vla-get-ModelSpace acdoc)
    (vla-get-PaperSpace acdoc)
 )
 )
 (cond
   (
    (not
      (setq dwg (getfiled "Select Drawing to Copy From" "" "dwg" 16))
    )
    (princ "\n*Cancel*")
   )
   (
    (eq dwg (vla-get-fullname acdoc))
    (princ "\n** Cannot Copy from Active Drawing **")
   )
   (
    (not (setq dbxDoc (LM:GetDocumentObject dwg)))
    (princ "\n** Unable to Interface with Selected Drawing **")
   )
   (
    (not
      (progn
 (vlax-for b (vla-get-Blocks dbxDoc)
   (if (not (or (eq :vlax-true (vla-get-isXRef b))
  (eq :vlax-true (vla-get-isLayout b))
     )
       )
     (setq lst (cons (vla-get-name b) lst))
   )
 )
 (setq lst
 (acad_strlsort
   (vl-remove-if '(lambda (x) (tblsearch "BLOCK" x)) lst)
 )
 )
      )
    )
    (princ
      "\n** No distinct Blocks Found in Selected Drawing **"
    )
   )
   (
    (not
      (progn
 (setq dcfname (vl-filename-mktemp nil nil ".dcl"))
 (if (setq file (open dcfname "w"))
   (progn
     (write-line
       "copyblock : dialog { label = \"Select Block to Copy...\"; spacer; : list_box { key = \"blocks\"; } spacer; ok_cancel;}"
       file
     )
     (not (setq file (close file)))
   )
 )
      )
    )
    (princ "\n** Unable to Write DCL File **")
   )
   (
    (<= (setq dc (load_dialog dcfname)) 0)
    (princ "\n** DCL File not Found **")
   )
   (
    (not (new_dialog "copyblock" dc))
    (princ "\n** Unable to Load Dialog **")
   )
   (t
    (start_list "blocks")
    (mapcar 'add_list lst)
    (end_list)
    (setq ptr (set_tile "blocks" "0"))
    (action_tile "blocks" "(setq ptr $value)")
    (setq fl (start_dialog)
   dc (unload_dialog dc)
    )
    (if (and (= 1 fl)
      (setq pt (getpoint "\nSpecify Point for Block: "))
 )
      (progn
 (vla-CopyObjects
   dbxDoc
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray vlax-vbObject '(0 . 0))
       (list (LM:Itemp (vla-get-blocks dbxDoc)
         (setq block (nth (atoi ptr) lst))
      )
       )
     )
   )
   acblk
 )
 (setq norm (trans '(0. 0. 1.) 1 0 t))
 (if (LM:Itemp acblk block)
   (vla-insertBlock
     spc
     (vlax-3D-point (trans pt 1 0))
     block
     1.
     1.
     1.
     (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t))
   )
 )
      )
      (princ "\n*Cancel*")
    )
   )
 )
 (if (and dcfname (setq dcfname (findfile dcfname)))
   (vl-file-delete dcfname)
 )
 (if dbxDoc
   (vlax-release-object dbxDoc)
 )
 (princ)
)
;;-----------------=={ Get Document Object }==----------------;;
;;                                                            ;;
;;  Retrieves a the VLA Document Object for the specified     ;;
;;  filename. Document Object may be present in the Documents ;;
;;  collection, or obtained through ObjectDBX                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  filename - filename for which to retrieve document object ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Document Object, else nil                   ;;
;;------------------------------------------------------------;;
(defun LM:GetDocumentObject (filename / acdocs dbx)
 (vl-load-com)
 ;; © Lee Mac 2010
 (vlax-map-collection
   (vla-get-Documents (vlax-get-acad-object))
   (function
     (lambda (doc)
(setq acdocs
       (cons
  (cons (strcase (vla-get-fullname doc)) doc)
  acdocs
       )
)
     )
   )
 )
 (cond
   ((not (setq filename (findfile filename))) nil)
   ((cdr (assoc (strcase filename) acdocs)))
   ((not
      (vl-catch-all-error-p
 (vl-catch-all-apply
   'vla-open
   (list (setq dbx (LM:ObjectDBXDocument)) filename)
 )
      )
    )
    dbx
   )
 )
)
;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                            ;;
;;  Retrieves a version specific ObjectDBX Document object    ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments: - None -                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA ObjectDBX Document object, else nil         ;;
;;------------------------------------------------------------;;
(defun LM:ObjectDBXDocument (/ acVer)
 ;; © Lee Mac 2010
 (vla-GetInterfaceObject
   (vlax-get-acad-object)
   (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
     "ObjectDBX.AxDbDocument"
     (strcat "ObjectDBX.AxDbDocument." (itoa acVer))
   )
 )
)
;;-----------------------=={ Itemp }==------------------------;;
;;                                                            ;;
;;  Retrieves the item with index 'item' if present in the    ;;
;;  specified collection, else nil                            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  coll - the VLA Collection Object                          ;;
;;  item - the index of the item to be retrieved              ;;
;;------------------------------------------------------------;;
;;  Returns:  the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;
(defun LM:Itemp (coll item)
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
(setq item
       (vl-catch-all-apply
  (function vla-item)
  (list coll item)
       )
)
     )
   )
    item
 )
)

Edited April 13, 2018 by rlx

April 13, 2018

OOh!!! Thanks rlx, let me have a look at this one, looks like a lot in it!! probably wont need all ah!?!?

;;--------------=={ Copy Block From Drawing }==---------------;;
;;                                                            ;;
;;  Copies the selected block definition from the selected    ;;
;;  drawing to the ActiveDocument using a deep clone          ;;
;;  operation.                                                ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
(defun c:cb (/     *error*   acapp  acdoc acblk  spc    dwg
     dbxDoc lst    dcfname  file dc     ptr    fl
     pt     norm   block
    )
 (vl-load-com)
 ;; © Lee Mac 2010
 (defun *error* (msg)
   (vl-catch-all-apply
     '(lambda nil
 (if dbxDoc
   (vlax-release-object dbxDoc)
 )
 (if (and file (eq 'FILE (type file)))
   (setq file (close file))
 )
 (if (and dcfname (setq dcfname (findfile dcfname)))
   (vl-file-delete dcfname)
 )
 (if dc
   (unload_dialog dc)
 )
      )
   )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (setq acapp (vlax-get-acad-object)
acdoc (vla-get-ActiveDocument acapp)
acblk (vla-get-Blocks acdoc)
 )
 (setq spc
 (if
   (or (eq AcModelSpace (vla-get-ActiveSpace acdoc))
       (eq :vlax-true (vla-get-MSpace acdoc))
   )
    (vla-get-ModelSpace acdoc)
    (vla-get-PaperSpace acdoc)
 )
 )
 (cond
   (
    (not
      (setq dwg (getfiled "Select Drawing to Copy From" "" "dwg" 16))
    )
    (princ "\n*Cancel*")
   )
   (
    (eq dwg (vla-get-fullname acdoc))
    (princ "\n** Cannot Copy from Active Drawing **")
   )
   (
    (not (setq dbxDoc (LM:GetDocumentObject dwg)))
    (princ "\n** Unable to Interface with Selected Drawing **")
   )
   (
    (not
      (progn
 (vlax-for b (vla-get-Blocks dbxDoc)
   (if (not (or (eq :vlax-true (vla-get-isXRef b))
  (eq :vlax-true (vla-get-isLayout b))
     )
       )
     (setq lst (cons (vla-get-name b) lst))
   )
 )
 (setq lst
 (acad_strlsort
   (vl-remove-if '(lambda (x) (tblsearch "BLOCK" x)) lst)
 )
 )
      )
    )
    (princ
      "\n** No distinct Blocks Found in Selected Drawing **"
    )
   )
   (
    (not
      (progn
 (setq dcfname (vl-filename-mktemp nil nil ".dcl"))
 (if (setq file (open dcfname "w"))
   (progn
     (write-line
       "copyblock : dialog { label = \"Select Block to Copy...\"; spacer; : list_box { key = \"blocks\"; } spacer; ok_cancel;}"
       file
     )
     (not (setq file (close file)))
   )
 )
      )
    )
    (princ "\n** Unable to Write DCL File **")
   )
   (
    (<= (setq dc (load_dialog dcfname)) 0)
    (princ "\n** DCL File not Found **")
   )
   (
    (not (new_dialog "copyblock" dc))
    (princ "\n** Unable to Load Dialog **")
   )
   (t
    (start_list "blocks")
    (mapcar 'add_list lst)
    (end_list)
    (setq ptr (set_tile "blocks" "0"))
    (action_tile "blocks" "(setq ptr $value)")
    (setq fl (start_dialog)
   dc (unload_dialog dc)
    )
    (if (and (= 1 fl)
      (setq pt (getpoint "\nSpecify Point for Block: "))
 )
      (progn
 (vla-CopyObjects
   dbxDoc
   (vlax-make-variant
     (vlax-safearray-fill
       (vlax-make-safearray vlax-vbObject '(0 . 0))
       (list (LM:Itemp (vla-get-blocks dbxDoc)
         (setq block (nth (atoi ptr) lst))
      )
       )
     )
   )
   acblk
 )
 (setq norm (trans '(0. 0. 1.) 1 0 t))
 (if (LM:Itemp acblk block)
   (vla-insertBlock
     spc
     (vlax-3D-point (trans pt 1 0))
     block
     1.
     1.
     1.
     (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t))
   )
 )
      )
      (princ "\n*Cancel*")
    )
   )
 )
 (if (and dcfname (setq dcfname (findfile dcfname)))
   (vl-file-delete dcfname)
 )
 (if dbxDoc
   (vlax-release-object dbxDoc)
 )
 (princ)
)
;;-----------------=={ Get Document Object }==----------------;;
;;                                                            ;;
;;  Retrieves a the VLA Document Object for the specified     ;;
;;  filename. Document Object may be present in the Documents ;;
;;  collection, or obtained through ObjectDBX                 ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  filename - filename for which to retrieve document object ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Document Object, else nil                   ;;
;;------------------------------------------------------------;;
(defun LM:GetDocumentObject (filename / acdocs dbx)
 (vl-load-com)
 ;; © Lee Mac 2010
 (vlax-map-collection
   (vla-get-Documents (vlax-get-acad-object))
   (function
     (lambda (doc)
(setq acdocs
       (cons
  (cons (strcase (vla-get-fullname doc)) doc)
  acdocs
       )
)
     )
   )
 )
 (cond
   ((not (setq filename (findfile filename))) nil)
   ((cdr (assoc (strcase filename) acdocs)))
   ((not
      (vl-catch-all-error-p
 (vl-catch-all-apply
   'vla-open
   (list (setq dbx (LM:ObjectDBXDocument)) filename)
 )
      )
    )
    dbx
   )
 )
)
;;-----------------=={ ObjectDBX Document }==-----------------;;
;;                                                            ;;
;;  Retrieves a version specific ObjectDBX Document object    ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments: - None -                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA ObjectDBX Document object, else nil         ;;
;;------------------------------------------------------------;;
(defun LM:ObjectDBXDocument (/ acVer)
 ;; © Lee Mac 2010
 (vla-GetInterfaceObject
   (vlax-get-acad-object)
   (if (< (setq acVer (atoi (getvar "ACADVER"))) 16)
     "ObjectDBX.AxDbDocument"
     (strcat "ObjectDBX.AxDbDocument." (itoa acVer))
   )
 )
)
;;-----------------------=={ Itemp }==------------------------;;
;;                                                            ;;
;;  Retrieves the item with index 'item' if present in the    ;;
;;  specified collection, else nil                            ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]             ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee @ lee-mac.com                                ;;
;;  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com    ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  coll - the VLA Collection Object                          ;;
;;  item - the index of the item to be retrieved              ;;
;;------------------------------------------------------------;;
;;  Returns:  the VLA Object at the specified index, else nil ;;
;;------------------------------------------------------------;;
(defun LM:Itemp (coll item)
 ;; © Lee Mac 2010
 (if
   (not
     (vl-catch-all-error-p
(setq item
       (vl-catch-all-apply
  (function vla-item)
  (list coll item)
       )
)
     )
   )
    item
 )
)

(defun getnames (xlsfname / nName) ;<<xlsfname - provide valid filename with path
 (vl-load-com)
    ;make proper excel objects
 (setq
   xlApp   (vlax-create-object "Excel.Application")
   xlWBook (vlax-get xlApp "Workbooks")
   xlFile  (vlax-invoke-method xlWBook "Open" xlsfname)
   xlNames (vlax-get xlFile "Names")
 )
    ;make excel unvisible
 (vlax-put-property xlApp "Visible" :vlax-false)
    ;names count from opened workbook
 (setq ncnt (vlax-get-property xlNames "Count"))
    ;set nil to var containing names
 (setq nName nil)
    ;set counter
 (setq i 1)
    ;put names to var
 (while (< i (1+ ncnt))
   (setq xlNName (vlax-invoke xlNames "Item" i))
    ;<<<< vlax-invoke instead of vlax-get-property, that was a catch, thank you!
   (setq nName (cons (vlax-get-property xlNName "Name") nName))
   (setq i (1+ i))
 )
    ;sort list of names
 (setq nName (vl-sort nName '<))
    ;close excel file without saving
 (vlax-invoke-method xlFile 'Close :vlax-False)
    ;quit excel
 (vl-catch-all-apply 'vlax-invoke-method (list xlApp 'Quit))
    ;release objects
 (mapcar '(lambda (x) (vlax-release-object x))
  (list xlNName xlNames xlFile xlWBook xlApp)
 )
    ;clear vars
 (mapcar '(lambda (x) (setq x nil) (gc))
  (list i xlNName xlNames xlFile xlWBook xlApp)
 )
    ;garbage collection
 (gc)
 (gc)
 nName     ;<<return list of names from xlsfname
)

(defun SelectXlsFileName ( / xl)
 (setq xl (getfiled "Select Excel File" "" "xls" 0))(if (and xl (findfile xl))xl nil))
(defun c:tst ( / xl)(if (setq xl (SelectXlsFileName))(getnames xl)))

April 13, 2018

Outstanding rlx, the lisp cavalry has arrived!

Vintage Lee Mac from the looks of it, no longer on his website.

April 13, 2018

Outstanding rlx, the lisp cavalry has arrived!
Vintage Lee Mac from the looks of it, no longer on his website.

yeah , used it for study when I created my own block routine but that one is a little over the top so thought it would be a better idea to show Lee's version (btw , congratulations Lee with your birthday , yesterday I believe)

April 13, 2018

yeah , used it for study when I created my own block routine but that one is a little over the top so thought it would be a better idea to show Lee's version (btw , congratulations Lee with your birthday , yesterday I believe)

Oh yeah, TODAY is Lee's birthday.

Happy Birthday Lee Mac, thanks for all your incredible lisps!

April 13, 2018

Cheers Lee!!!

code (not mine) is quite slow to start , 2 minutes or so?, and could probably be programmed more efficiently , but the end result looks nice...

Lee

;-------------------------------------------------------------------------------
; Program Name: FireWorks.lsp [FireWorks R2] - AutoLISP graphics animation Created By: Terry Miller
; (Email: [email="terrycadd@yahoo.com"]terrycadd@yahoo.com[/email]) (URL: [url]http://web2.airmail.net/terrycad[/url]) (File: [url]http://web2.airmail.net/terrycad/LISP/FireWorks.lsp[/url])
; Date Created: 7-1-08
; Notes: FireWorks is an AutoLISP graphics animation program. It can be run inside of an existing drawing. When it's finished, it purges
; the layer FireWorks and all entities it created. Press P to pause the animation, or press Q to quit in order to purge the layer and
; entities it created. If you pressed the escape key to abort, you can simply rerun FireWorks again and press Q to quit. So do not
; press the escape key to abort the animation.
; Disclaimer:   This program is free to download and share and learn from. It contains many useful functions that may be applied else where.
;               Every effort on my part has been to create a graphics animation that will run in most versions of AutoCAD, and when finished it
;               will return to the environment before it started. FireWorks is now yours to tweak, debug, add to, rename, use parts of, or create
;               another graphics animation from. It is now your responsibility when, and within what drawings you should run it. If you are
;               unsure of how it may affect certain drawing environments, do a saveas before running it. Do not save a drawing without running
;               FireWorks and pressing Q to quit.
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM   7-1-08    Initial version.
; 2    TM   7-3-08    Revised function to use less blocks more efficiently, and
;                     added a delay between FireWorks displays.
;-------------------------------------------------------------------------------
; c:FireWorks - FireWorks AutoLISP graphics animation program
;-------------------------------------------------------------------------------
(defun c:FW () (load "FireWorks") (c:FireWorks)) ;Shortcut
(defun c:FireWorks  (/ Block$ BlockA1$ BlockA2$ BlockB1$ BlockB2$ BlockC1$ BlockC2$ BlockD1$ BlockD2$ BlockE1$ BlockE2$ BlockF1$ BlockF2$ BlockG1$
                    BlockG2$ BlockH1$ BlockH2$ BlockI1$ BlockI2$ BlockJ1$ BlockJ2$ BlockK1$ BlockK2$ BlockL1$ BlockL2$ Blocks@ Class# Clayer$
                    Cnt# Cnt1# Cnt2# Cnt3# Cnt4# Cnt5# Cnt6# Cnt7# Cnt8# Cnt9# Cnt10# Cnt11# Cnt12# Code# Color1# Color2# Dia~ Ent1^ Ent2^ Ent3^
                    Ent4^ Ent5^ Ent6^ Ent7^ Ent8^ Ent9^ Ent10^ Ent11^ Ent12^ FireWorks: HRange InsBase InsScales@ Int# List@ LLpt LMpt Loop LRpt
                    MoveWorks: Moving MultiColors@ Num# Num1# Num2# Order@ Osmode# P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 RangeIns Read@
                    SingleColors@ SS& SubLoop Temp@ Total# ULpt UMpt Unique Unique$ UniqueName$ Uniques@ Unit~ URpt Value ViewCtr ViewExtents@
                    ViewSize~ ViewWidth~ VRange)
 ;-----------------------------------------------------------------------------
 ; FireWorks: - Draws FireWorks - Arguments: 4 - Ins = Insertion point, Dia~ = Diameter, Color1# = Spark color, Color2# = Trailing color
 ; Returns: Draws FireWorks and returns a list of the block names created.
 ;-----------------------------------------------------------------------------
 (defun FireWorks:  (Ins Dia~ Color1# Color2# / Ang~ AngChg~ Block1$ Block2$ Block3$ Block4$ Cen Cnt# Color3# Color4# ColorA1# ColorA2# ColorA3#
                     ColorA4# ColorB1# ColorB2# ColorB3# ColorB4# Left# Len~ Num# P1 P2 P3 Rad~ Right# RndColor RndColors: SS1& SS2& SS3& SS4&
                     TwoColors UniqueName$ Unit~ Vortex)
   (defun RndColors:  ()
     (setq Color1# (* 10 (1+ (RndInt 23))) Color2# Color1#)
     (while (< (abs (- Color1# Color2#)) 30) (setq Color2# (* 10 (1+ (RndInt 23))))) ;while
     (setq Color2# (+ Color2# 4) Color3# (+ Color1#   Color4# (+ Color2# 5))
     (if TwoColors
       (if (IsEven (/ Cnt# 2))
         (if (not ColorB1#) (setq ColorB1# Color1# ColorB2# Color2# ColorB3# Color3# ColorB4# Color4#)
                            (setq Color1# ColorB1# Color2# ColorB2# Color3# ColorB3# Color4# ColorB4#))
         (if (not ColorA1#) (setq ColorA1# Color1# ColorA2# Color2# ColorA3# Color3# ColorA4# Color4#)
                            (setq Color1# ColorA1# Color2# ColorA2# Color3# ColorA3# Color4# ColorA4#)))))
   (if (not Color1#)
     (progn (setq RndColor t) (if (not Color2#)(setq TwoColors t))) (setq Color3# (+ Color1#  Color4# (+ Color2# 5)))
   (setq Unit~ (/ Dia~ 80.0) Vortex (polar Ins (d2r 90) (* Unit~ 9)) Cen (polar Ins (d2r 90) (* Unit~ 9)) SS1& (ssadd) SS2& (ssadd) SS3& (ssadd)
         SS4& (ssadd) Right# 4 Left# 6 Ang~ 30 Num# 0 Cnt# 0 AngChg~ 7.5 Cen (polar Cen (d2r 270) (* Unit~ 3)) Rad~ (* Unit~ 9))
   (while (<= Ang~ 90)
     (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0))))) Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01)
           P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~) (* Len~ (1+ (RndInt 9)) 0.1))) P2 (polar P1 (angle Vortex P1) (* Len~ 0.75))
           P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
     (if RndColor (RndColors:))
     (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color4# "") (if (IsEven Cnt#) (ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
     (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color3# "") (if (IsEven Cnt#) (ssadd (entlast) SS2&) (ssadd (entlast) SS4&))
     (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color2# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
     (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color1# "") (if (IsEven Cnt#) (ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
     (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~) Ang~ (r2d (d2r Ang~)) Cnt# (1+ Cnt#))
   )
   (setq Cen (polar Ins (d2r 90) (* Unit~ 9)))
   (while (< (setq Num# (1+ Num#)) 
     (setq Cen (polar Cen (d2r 270) (* Unit~ 3)) Rad~ (* Unit~ (setq Right# (+ Right# 5))) AngChg~ (- AngChg~ 0.5))
     (while (<= Ang~ 270)
       (if (<= Ang~ 180)(setq Len~ (+ Unit~ (* Unit~ (* 2 (/ (- Ang~ 90) 90.0))))) (setq Len~ (+ (* Unit~ 3) (* Unit~ (* 2 (/ (- Ang~ 180) 90.0))))))
       (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01) P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~) (* Len~ (1+ (RndInt 9)) 0.1)))
             P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)) P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
       (if RndColor (RndColors:))
       (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color4# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
       (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color3# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
       (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color2# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
       (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color1# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
       (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~) Ang~ (r2d (d2r Ang~)) Cnt# (1+ Cnt#))
     )
     (if (/= Num# 7)
       (progn
         (setq Cen (polar Cen (d2r 90) (* Unit~ 2)) Rad~ (* Unit~ (setq Left# (+ Left# 5))) AngChg~ (- AngChg~ 0.5))
         (while (or (>= Ang~ 270) (<= Ang~ 90))
           (if (<= Ang~ 90)
             (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0)))))) (setq Len~ (+ (* Unit~ 3) (* Unit~ (- 2 (* 2 (/ (- Ang~ 270) 90.0)))))))
           (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01) P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~) (* Len~ (1+ (RndInt 9)) 0.1)))
                 P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)) P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
           (if RndColor (RndColors:))
           (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color4# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
           (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color3# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
           (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color2# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
           (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color1# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
           (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~) Ang~ (r2d (d2r Ang~)) Cnt# (1+ Cnt#)))))
     (setq Vortex (polar Vortex (d2r 90) (* Unit~ 2)))
   ) 
   (setq AngChg~ (- AngChg~ 0.5))
   (while (or (>= Ang~ 270) (<= Ang~ 30))
     (if (<= Ang~ 90)
       (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0)))))) (setq Len~ (+ (* Unit~ 3) (* Unit~ (- 2 (* 2 (/ (- Ang~ 270) 90.0)))))))
     (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01) P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~) (* Len~ (1+ (RndInt 9)) 0.1)))
           P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)) P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
     (if RndColor (RndColors:))
     (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color4# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
     (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color3# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
     (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color2# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
     (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color1# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
     (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~) Ang~ (r2d (d2r Ang~)) Cnt# (1+ Cnt#))
   )
   (setq UniqueName$ (UniqueName) Block1$ (strcat UniqueName$ "1")) (command "block" Block1$ Ins SS1& "") (setq Block2$ (strcat UniqueName$ "2"))
   (command "block" Block2$ Ins SS2& "") (setq Block3$ (strcat UniqueName$ "3")) (command "block" Block3$ Ins SS3& "")
   (setq Block4$ (strcat UniqueName$ "4")) (command "block" Block4$ Ins SS4& "")(list Block1$ Block2$ Block3$ Block4$)
 ) ;defun FireWorks:
 ; MoveWorks: - Moves FireWorks
 ; Arguments: 7  Pt = Last scaled point, EntName^ = Entity name of block, Cnt# = Counter value of FireWork, Block1$ = Exploding block name
 ;               Block2$ = Fading block name, Mirror = t or nil to mirror block, InsAngle~ = Insertion angle
 ; Returns: Moves FireWork and returns a list of the next Pt and EntName^.;-----------------------------------------------------------------------------
 (defun MoveWorks:  (Pt EntName^ Num# Block1$ Block2$ Mirror InsAngle~ / Dist~ EntList@ InsPt List@ Scale1~ Scale2~)
   (if (= Num# 0)
     (progn (if Mirror (setq Scale1~ -0.1 Scale2~ 0.1) (setq Scale1~ 0.1 Scale2~ 0.1))
            (command "insert" Block1$ Pt Scale1~ Scale2~ InsAngle~) (setq EntName^ (entlast))))
   (if (= Num# 15)
     (progn (setq EntList@ (entget EntName^) InsPt (cdr (assoc 10 EntList@)) Scale2~ (abs (cdr (assoc 41 EntList@))))
            (if Mirror (setq Scale1~ (* Scale2~ -1)) (setq Scale1~ Scale2~)) (command "erase" EntName^ "")
            (command "insert" Block2$ InsPt Scale1~ Scale2~ InsAngle~)(setq EntName^ (entlast))))
   (if (and (>= Num# 0) (< Num# (length InsScales@)))
     (progn (setq List@ (nth Num# InsScales@) Scale1~ (nth 1 List@) Dist~ (* (nth 0 List@) Dia~) Pt (polar Pt (d2r 90) Dist~))
            (command "scale" EntName^ "" Pt Scale1~)))(if (= Num# (length InsScales@)) (command "erase" EntName^ ""))
   (list Pt EntName^)
 );defun MoveWorks:
 
 ; Start of Main Function
 (setq InsScales@  (list (list 0.00110000 1.90856943)(list 0.00449390 1.45507457)(list 0.00718449 1.29831044)(list 0.01030948 1.21861287)
                         (list 0.01397743 1.17020200)(list 0.01832986 1.13754799)(list 0.02355727 1.11392604)(list 0.02992505 1.09594905)
                         (list 0.03779755 1.08172391)(list 0.04769797 1.07010796)(list 0.06040343 1.06036909)(list 0.07709087 1.05201493)
                         (list 0.09962908 1.04470041)(list 0.13111964 1.03817470)(list 0.17703691 1.03224916)(list 0.24777800 1.02677702)
                         (list 0.36515870 1.02164006)(list 0.58168146 1.01673937)(list 1.05262733 1.01198870)))
 (setq Order@ (list 1 2 1 2 3 4 3 4 1 2 1 2 3 4 3 4 1 2 1 2 3 4 3 4))
 (setvar "cmdecho" 0)(if (/= (getvar "ctab") "Model")(command "pspace"))(command "undo" "begin")(gc)
 (setq ViewExtents@ (ViewExtents) ULpt (car ViewExtents@) LRpt (cadr ViewExtents@) LLpt (list (car ULpt) (cadr LRpt))
       URpt (list (car LRpt) (cadr ULpt)) ViewSize~ (getvar "viewsize") Unit~ (/ ViewSize~ 100.0) ViewWidth~ (distance ULpt URpt)
       ViewCtr (getvar "viewctr") UMpt (list (car ViewCtr) (cadr ULpt)) LMpt (list (car ViewCtr) (cadr LLpt)) VRange 37
       HRange (fix (/ (- ViewWidth~ (* Unit~ 56)) Unit~)))
 (if (IsEven HRange)(setq HRange (1- HRange)))
 (setq RangeIns (polar LLpt 0 (* Unit~ 28)) RangeIns (polar RangeIns (d2r 90) (* Unit~ 47)) InsBase (polar UMpt (d2r 90) ViewSize~)
       Dia~ (* Unit~ 50) Osmode# (getvar "osmode"))
 (setvar "osmode" 0) (setvar "blipmode" 0)(setq Clayer$ (getvar "clayer"))
 (if (tblsearch "layer" "FireWorks")
   (command "layer" "t" "FireWorks" "u" "FireWorks" "on" "FireWorks" "s" "FireWorks" "")(command "layer" "m" "FireWorks" "c" 250 "" ""))
 (if (setq SS& (ssget "x" (list '(8 . "FireWorks")))) (command "erase" SS& ""))(setq Block$ (strcat (substr (UniqueName) 1 5) "*"))
 (command "purge" "bl" Block$ "n")(repeat 40 (princ (strcat "\n" (chr 160))))
 (princ "\nCreating FireWorks...   1% Complete\010\010\010\010\010\010\010\010\010\010")(princ)
 (setq Class# 1 Int# 1 Total# 24)
 (while (< (length MultiColors@) 24)
   (if (IsEven Class#)
     (if (or (= Class# 2) (= Class# 6)) (setq Color1# nil Color2# nil) (setq Color1# nil Color2# t))
     (progn
       (setq Unique nil)
       (while (not Unique)
         (setq Color1# (* 10 (1+ (RndInt 23))) Color2# Color1#)
         (while (< (abs (- Color1# Color2#)) 30) (setq Color2# (* 10 (1+ (RndInt 23)))))
         (setq Color2# (+ Color2# 4) Unique$ (strcat (itoa Color1#) "-" (itoa Color2#)))
         (if (not (member Unique$ Uniques@)) (progn (setq Uniques@ (append Uniques@ (list Unique$))) (setq Unique t))))
     )
   )
   (setq Blocks@ (FireWorks: InsBase Dia~ Color1# Color2#))
   (if (IsEven Class#)
     (setq MultiColors@ (append MultiColors@ (list (nth 0 Blocks@) (nth 1 Blocks@))))
     (setq SingleColors@ (append SingleColors@ (list (nth 0 Blocks@) (nth 1 Blocks@)))))
   (setq Class# (1+ Class#)) (if (= Class# 9)(setq Class# 1)) (setq Num# (fix (/ Int# (* Total# 0.01))))
   (cond ((< Num# 10) (princ "\010"))((< Num# 100) (princ "\010\010"))((>= Num# 100) (princ "\010\010\010")))
   (princ (itoa Num#)) (princ) (setq Int# (1+ Int#))
 );while
 (command "delay" 100) (repeat 5 (princ (strcat "\n" (chr 160)))) (princ "\nFireWorks - Press P to pause, or Q to quit. ") (princ)
 (setq Loop t Class# 1)
 (while Loop
   (setq Blocks@ nil)
   (cond ((= Class# 1) ;One Single Color
          (setq Num# (* (RndInt 11) 2) UniqueName$ (nth Num# SingleColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (foreach Int# Order@ (setq Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)))))
         ((= Class# 2) ;One Two-Colors
          (setq Num# (* (RndInt 5) 4) UniqueName$ (nth Num# MultiColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (foreach Int# Order@ (setq Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)))))
         ((= Class# 3) ;Two Single Colors
          (setq Num1# (* (RndInt 11) 2) SubLoop t)
          (while SubLoop (setq Num2# (* (RndInt 11) 2)) (if (/= Num2# Num1#) (setq SubLoop nil)))(setq Cnt# 0)
          (foreach Int# Order@
            (if (IsEven Cnt#)(setq Num# Num2#)(setq Num# Num1#))
            (setq UniqueName$ (nth Num# SingleColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$)))
                  Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)) Cnt# (1+ Cnt#))))
         ((= Class# 4) ;One Multi-Colors
          (setq Num# (+ 2 (* (RndInt 5) 4)) UniqueName$ (nth Num# MultiColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (foreach Int# Order@ (setq Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)))))
         ((= Class# 5) ;One Single Color
          (setq Num# (* (RndInt 11) 2) UniqueName$ (nth Num# SingleColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (foreach Int# Order@ (setq Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)))))
         ((= Class# 6) ;Random Two-Colors
          (repeat 2
            (setq Temp@ List@ List@ nil)
            (while (< (length List@) 6) (setq Num# (* (RndInt 5) 4))(if (not (member Num# List@))(setq List@ (append List@ (list Num#)))))
            (foreach Num# List@ (setq List@ (append List@ (list Num#)))))
          (foreach Num# Temp@ (setq List@ (append List@ (list Num#))))
          (setq Cnt# 0)
          (foreach Int#  Order@
            (setq Num# (nth Cnt# List@) UniqueName$ (nth Num# MultiColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$)))
                  Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)) Cnt# (1+ Cnt#))))
         ((= Class# 7) ;Two Single Colors
          (setq Num1# (* (RndInt 11) 2) SubLoop t)
          (while SubLoop (setq Num2# (* (RndInt 11) 2)) (if (/= Num2# Num1#)(setq SubLoop nil)))
          (setq Cnt# 0)
          (foreach Int# Order@
            (if (< Cnt# 4) (setq Num# Num2#)(setq Num# Num1#))
            (setq UniqueName$ (nth Num# SingleColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$)))
                  Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)) Cnt# (1+ Cnt#))
            (if (= Cnt#  (setq Cnt# 0))))
         ((= Class#  ;Random Multi-Colors
          (repeat 2
            (setq Temp@ List@ List@ nil)
            (while (< (length List@) 6)(setq Num# (+ 2 (* (RndInt 5) 4)))(if (not (member Num# List@))(setq List@ (append List@ (list Num#)))))
            (foreach Num# List@ (setq List@ (append List@ (list Num#)))))
          (foreach Num# Temp@ (setq List@ (append List@ (list Num#)))) ;foreach
          (setq Cnt# 0)
          (foreach Int#  Order@
            (setq Num# (nth Cnt# List@) UniqueName$ (nth Num# MultiColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$)))
                  Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)) Cnt# (1+ Cnt#))))
   ) ;cond
   (setq BlockA1$ (nth 0 Blocks@) BlockA2$ (nth 1 Blocks@) BlockB1$ (nth 2 Blocks@) BlockB2$ (nth 3 Blocks@) BlockC1$ (nth 4 Blocks@)
         BlockC2$ (nth 5 Blocks@) BlockD1$ (nth 6 Blocks@) BlockD2$ (nth 7 Blocks@) BlockE1$ (nth 8 Blocks@) BlockE2$ (nth 9 Blocks@)
         BlockF1$ (nth 10 Blocks@) BlockF2$ (nth 11 Blocks@) BlockG1$ (nth 12 Blocks@) BlockG2$ (nth 13 Blocks@) BlockH1$ (nth 14 Blocks@)
         BlockH2$ (nth 15 Blocks@) BlockI1$ (nth 16 Blocks@) BlockI2$ (nth 17 Blocks@) BlockJ1$ (nth 18 Blocks@) BlockJ2$ (nth 19 Blocks@)
         BlockK1$ (nth 20 Blocks@) BlockK2$ (nth 21 Blocks@) BlockL1$ (nth 22 Blocks@) BlockL2$ (nth 23 Blocks@))
   (setq P1 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P2 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P3 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P4 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P5 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P6 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P7 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P8 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P9 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P10 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P11 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P12 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P1 (polar P1 (d2r 90) (* Unit~ (RndInt VRange))) P2 (polar P2 (d2r 90) (* Unit~ (RndInt VRange)))
         P3 (polar P3 (d2r 90) (* Unit~ (RndInt VRange))) P4 (polar P4 (d2r 90) (* Unit~ (RndInt VRange)))
         P5 (polar P5 (d2r 90) (* Unit~ (RndInt VRange))) P6 (polar P6 (d2r 90) (* Unit~ (RndInt VRange)))
         P7 (polar P7 (d2r 90) (* Unit~ (RndInt VRange))) P8 (polar P8 (d2r 90) (* Unit~ (RndInt VRange)))
         P9 (polar P9 (d2r 90) (* Unit~ (RndInt VRange))) P10 (polar P10 (d2r 90) (* Unit~ (RndInt VRange)))
         P11 (polar P11 (d2r 90) (* Unit~ (RndInt VRange))) P12 (polar P12 (d2r 90) (* Unit~ (RndInt VRange))))
   (setq Cnt1#  -1 Cnt2#  (- Cnt1# 3) Cnt3#  (- Cnt2# 3) Cnt4#  (- Cnt3# 3) Cnt5#  (- Cnt4# 3) Cnt6#  (- Cnt5# 3) Cnt7#  (- Cnt6# 3)
         Cnt8#  (- Cnt7# 3) Cnt9#  (- Cnt8# 3) Cnt10# (- Cnt9# 3) Cnt11# (- Cnt10# 3) Cnt12# (- Cnt11# 3))
   (setq Moving t)
   (while Moving
     (command "zoom" LLpt URpt) (command "delay" 20)
     (setq Read@ (grread t 12 1) Code# (nth 0 Read@) Value (nth 1 Read@))
     (if (and (= Code# 2) (member Value (list 80 112))) ;P pressed
       (progn (getpoint "\nFireWorks paused.  Pick mouse to continue. ")(repeat 5 (princ (strcat "\n" (chr 160))))
              (command "zoom" LLpt URpt)(princ "\nFireWorks - Press P to pause, or Q to quit. ")(princ)))
     (if (and (= Code# 2) (member Value (list 81 113))) (setq Moving nil Loop nil)) ;Q pressed
     (command "zoom" LLpt URpt)
     (setq Cnt1# (1+ Cnt1#) Cnt2# (1+ Cnt2#) Cnt3# (1+ Cnt3#) Cnt4# (1+ Cnt4#) Cnt5# (1+ Cnt5#) Cnt6# (1+ Cnt6#) Cnt7# (1+ Cnt7#) Cnt8#  (1+ Cnt8#)
           Cnt9# (1+ Cnt9#) Cnt10# (1+ Cnt10#) Cnt11# (1+ Cnt11#) Cnt12# (1+ Cnt12#))
     (setq List@ (MoveWorks: P1 Ent1^ Cnt1# BlockA1$ BlockA2$ nil 0) P1 (nth 0 List@) Ent1^ (nth 1 List@))
     (setq List@ (MoveWorks: P2 Ent2^ Cnt2# BlockB1$ BlockB2$ t +3) P2 (nth 0 List@) Ent2^ (nth 1 List@))
     (setq List@ (MoveWorks: P3 Ent3^ Cnt3# BlockC1$ BlockC2$ nil 0))
     (setq P3 (nth 0 List@) Ent3^ (nth 1 List@) List@ (MoveWorks: P4 Ent4^ Cnt4# BlockD1$ BlockD2$ t -3))
     (setq P4 (nth 0 List@) Ent4^ (nth 1 List@) List@ (MoveWorks: P5 Ent5^ Cnt5# BlockE1$ BlockE2$ nil +3))
     (setq P5 (nth 0 List@) Ent5^ (nth 1 List@) List@ (MoveWorks: P6 Ent6^ Cnt6# BlockF1$ BlockF2$ t 0))
     (setq P6 (nth 0 List@) Ent6^ (nth 1 List@) List@ (MoveWorks: P7 Ent7^ Cnt7# BlockG1$ BlockG2$ nil -3))
     (setq P7 (nth 0 List@) Ent7^ (nth 1 List@) List@ (MoveWorks: P8 Ent8^ Cnt8# BlockH1$ BlockH2$ t 0))
     (setq P8 (nth 0 List@) Ent8^ (nth 1 List@) List@ (MoveWorks: P9 Ent9^ Cnt9# BlockI1$ BlockI2$ nil 0))
     (setq P9 (nth 0 List@) Ent9^ (nth 1 List@) List@ (MoveWorks: P10 Ent10^ Cnt10# BlockJ1$ BlockJ2$ t +3))
     (setq P10 (nth 0 List@) Ent10^ (nth 1 List@) List@ (MoveWorks: P11 Ent11^ Cnt11# BlockK1$ BlockK2$ nil 0))
     (setq P11 (nth 0 List@) Ent11^ (nth 1 List@) List@ (MoveWorks: P12 Ent12^ Cnt12# BlockL1$ BlockL2$ t -3))
     (setq P12 (nth 0 List@) Ent12^ (nth 1 List@))
     (if (= Cnt12# (+ (length InsScales@) 2)) (setq Moving nil))
   );while
   (setq Class# (1+ Class#))(if (= Class# 9) (setq Class# 1))(command "delay" 200);Adjust delay between displays as needed
 );while
 (command "undo" "end")(setvar "osmode" Osmode#)(setvar "clayer" Clayer$)
 (if (= (getvar "clayer") "FireWorks")(command "layer" "t" "0" "u" "0" "on" "0" "s" "0" ""))
 (if (setq SS& (ssget "x" (list '(8 . "FireWorks"))))(command "erase" SS& ""))
 (setq Block$ (strcat (substr (UniqueName) 1 5) "*"))(command "purge" "bl" Block$ "n")(command "purge" "la" "FireWorks" "n")
 (repeat 40(princ (strcat "\n" (chr 160))))(princ "\nFireWorks objects cleared.")
 (princ)
);defun c:FireWorks
; Start of FireWorks Support Utility Functions
; RndInt - Generates a random integer, Arguments: 1  Num# = Maximum random integer number range greater than or less than 0
; Returns: Random integer number between 0 and Num#.
(defun RndInt  (Num# / Half~ Loop MaxNum# Minus PiDate$ RndNum#)
 (if (or (/= (type Num#) 'INT) (= Num# 0))
   (progn (princ "\nSyntax: (RndInt Num#) Num# = Maximum random integer number range\ngreater than or less than 0.")(exit)))
 (if (< Num# 0)(setq MaxNum# (abs (1- Num#)) Minus   t)(setq MaxNum# (1+ Num#)))
 (setq Half~ (/ (1- MaxNum#) 2.0)) (if (not *RndNum*)(setq *RndNum* 10000)) (if (not *Int*)(setq *Int* 1))(setq Loop t)
 (while Loop
   (if (> *Int* 50)(setq *Int* 1)(setq *Int* (1+ *Int*)))
   (setq PiDate$ (rtos (* (getvar "cdate") (* pi *Int*)) 2 )
   (cond
     ((>= MaxNum# 10000)  (setq RndNum# (fix (* (atof (substr PiDate$ 13 5)) (* MaxNum# 0.00001)))))
     ((>= MaxNum# 1000)  (setq RndNum# (fix (* (atof (substr PiDate$ 14 4)) (* MaxNum# 0.0001)))))
     ((>= MaxNum# 100) (setq RndNum# (fix (* (atof (substr PiDate$ 15 3)) (* MaxNum# 0.001)))))
     ((>= MaxNum# 10) (setq RndNum# (fix (* (atof (substr PiDate$ 16 2)) (* MaxNum# 0.01)))))
     ((>= MaxNum# 1) (setq RndNum# (fix (* (atof (substr PiDate$ 17 1)) (* MaxNum# 0.1)))))
     (t (setq RndNum# 0)))
   (if
     (or (and (< RndNum# Half~) (< *RndNum* Half~)) (and (> RndNum# Half~) (> *RndNum* Half~)))
      (if (= (rem *Int* 2) 0)
        (setq RndNum# (- (1- MaxNum#) RndNum#))
        (if (> RndNum# Half~) (setq RndNum# (fix (- RndNum# Half~ 0.5)))(setq RndNum# (fix (+ RndNum# Half~ 0.5)))) ;if
        )                              ;if
      )                                ;if
   (if (/= RndNum# *RndNum*)
     (setq Loop nil))                  ;if
   )                                   ;while
 (setq *RndNum* RndNum#)
 (if Minus
   (setq RndNum# (* RndNum# -1)))      ;if
 RndNum#
);defun RndInt
; IsEven - Determines if a number is even or odd
; Arguments: 1 Num# = Number Returns: t if an even number else nil if an odd number
(defun IsEven (Num#) (= (rem Num# 2) 0))
; d2r - Degrees to radians in the range of 0 to less than 2pi
; Arguments: 1 Degrees = Angle in degrees Returns: Radians in the range of 0 to less than 2pi
(defun d2r  (Degrees / Radians)
 (while (< Degrees 0) (setq Degrees (- 360 (abs Degrees))))(while (>= Degrees 360) (setq Degrees (- Degrees 360)))
 (setq Radians (* pi (/ Degrees 180.0))) Radians)
; r2d - Radians to degrees in the range of 0 to less than 360 degrees
; Arguments: 1 Radians = Angle in radians Returns: Degrees in the range of 0 to less than 360 degrees
(defun r2d  (Radians / Degrees)
 (while (< Radians 0) (setq Radians (- (* pi 2) (abs Radians))))(while (>= Radians (* pi 2)) (setq Radians (- Radians (* pi 2))))
 (setq Degrees (* 180.0 (/ Radians pi))) Degrees)
; UniqueName - Creates a unique name for temp blocks and groups
(defun UniqueName  (/ Loop Name$)
 (setq Loop t)
 (while Loop
   (setq Name$ (rtos (getvar "CDATE") 2  Name$ (strcat (substr Name$ 4 5) (substr Name$ 10 ))
   (if (/= Name$ *UniqueName$) (setq *UniqueName$ Name$ Loop nil))) *UniqueName$)
;ViewExtents Returns: List of upper left and lower right points of current view
(defun ViewExtents  (/ A B C D X)
 (setq B (getvar "VIEWSIZE")  A (* B (/ (car (getvar "SCREENSIZE")) (cadr (getvar "SCREENSIZE"))))
       X (trans (getvar "VIEWCTR") 1 2) C (trans (list (- (car X) (/ A 2.0)) (+ (cadr X) (/ B 2.0))) 2 1)
       D (trans (list (+ (car X) (/ A 2.0)) (- (cadr X) (/ B 2.0))) 2 1)) (list C D))
(princ)
(c:FireWorks)

Edited April 13, 2018 by rlx

April 15, 2018

Nice one guys, Thanks heaps so far.

And Happy bday Lee....

Right-e-o i have had a look over Lee Mac's CB lisp but i'm not that good with lisps at the moment to fully understand what is going on in it.

Can i pick your brains guys to let me know what is going on?

Firstly, is it normal to not be able to "interface with the drawing" if someone has it open?

Secondly, where can i modify it so that is automatically selects a particular block from my "Master" drawing rather than selecting the drawing, then selecting the block from a dialog box of block?

Any help would be super or point me in the direction where i can find more info on this lisp!

Ta heaps

Mark

April 16, 2018

We just have old fashioned menu's set up with our blocks. They are individual on the server, again you can use tool palettes as well. They are multipaged automatically and set up by common type. Pretty quick to choose.

April 16, 2018

If you're not comfortable with lisp you should go with Bigal's solution. Assuming you want it any way :

1. yes (for this routine anyway, it is normal you can't interface with drawing that's already open)

2. there you go , with almost no testing cause I'm busy with work you know (or not haha) :

;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] Copyright © 2010 by Lee McDonnell, All Rights Reserved.                                ;;
;;  Contact: Lee @ lee-mac.com  -  Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com                                                ;;
;;                                                                                                                                       ;;
;;  modified by anonymous dragon to command line version                                                                                 ;;
;;  use : (copy-blocky dwg-name blk-name) something like : (copy-blocky "c:\\Temp\\TestDrawings\\TestDrawing1.dwg" "TestBlock1")         ;;
;;---------------------------------------------------------------------------------------------------------------------------------------;;
(defun copy-blocky ( $dwg $blk / *error* acapp acdoc acblk spc dwg dbxDoc lst pt norm )
 (defun *error* (msg)
   (vl-catch-all-apply
     '(lambda nil (if dbxDoc (vlax-release-object dbxDoc)) (if (and file (eq 'FILE (type file)))(setq file (close file)))
                  (if (and dcfname (setq dcfname (findfile dcfname)))(vl-file-delete dcfname))(if dc (unload_dialog dc))))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")(princ (strcat "\n** Error: " msg " **")))(princ))
 
 (setq acapp (vlax-get-acad-object) acdoc (vla-get-ActiveDocument acapp) acblk (vla-get-Blocks acdoc)
       spc (vla-get-block (vla-get-activelayout acdoc)))
 (cond
   ((or (null $dwg) (eq $dwg "")) (not (findfile $dwg)) (prompt "\nDrawing not found"))
   ((eq $dwg (vla-get-fullname acdoc)) (prompt "\n** Cannot Copy from Active Drawing **"))
   ((not (setq dbxDoc (LM:GetDocumentObject $dwg))) (prompt "\n** Unable to Interface with Selected Drawing **"))
   ((not
      (progn
        (vlax-for b (vla-get-Blocks dbxDoc)
          (if (not (or (eq :vlax-true (vla-get-isXRef b)) (eq :vlax-true (vla-get-isLayout b)))) (setq lst (cons (vla-get-name b) lst))))
        (setq lst (acad_strlsort (vl-remove-if '(lambda (x) (tblsearch "BLOCK" x)) lst)))))
    (prompt "\n** No distinct Blocks Found in Selected Drawing **"))
   ((or (null $blk)(eq $blk "")(not (member $blk lst))) (prompt "\nBlock not found in external drawing"))
   (t
    (if (setq pt (getpoint "\nSpecify Point for Block: "))
      (progn
 (vla-CopyObjects dbxDoc (vlax-make-variant (vlax-safearray-fill  (vlax-make-safearray vlax-vbObject '(0 . 0))
       (list (LM:Itemp (vla-get-blocks dbxDoc) $blk )))) acblk)
 (setq norm (trans '(0. 0. 1.) 1 0 t))
 (if (LM:Itemp acblk $blk)
   (vla-insertBlock spc (vlax-3D-point (trans pt 1 0)) $blk 1. 1. 1. (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 norm t)))))
      (princ "\n*Cancel*")
    )
   )
 )
 (if dbxDoc (vlax-release-object dbxDoc))
 (princ)
)
;;----------------------------------------------------=={ Get Document Object }==--------------------------------------------------------;;
;;                                                                                                                                       ;;
;;  Retrieves a the VLA Document Object for the specified filename. Document Object may be present in the Documents collection, or       ;;
;;  obtained through ObjectDBX                                                                                                           ;;
;;                                                                                                                                       ;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] , Copyright © 2010 by Lee McDonnell, All Rights Reserved.                              ;;
;;  Contact: Lee @ lee-mac.com , Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com                                                  ;;
;;                                                                                                                                       ;;
;;  Arguments:  filename - filename for which to retrieve document object                                                                ;;
;;  Returns:  VLA Document Object, else nil                                                                                              ;;
;;---------------------------------------------------------------------------------------------------------------------------------------;;
(defun LM:GetDocumentObject (filename / acdocs dbx)
 (vl-load-com)
 ;; © Lee Mac 2010
 (vlax-map-collection
   (vla-get-Documents (vlax-get-acad-object))
   (function (lambda (doc) (setq acdocs (cons (cons (strcase (vla-get-fullname doc)) doc) acdocs)))))
 
 (cond
   ((not (setq filename (findfile filename))) nil)
   ((cdr (assoc (strcase filename) acdocs)))
   ((not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list (setq dbx (LM:ObjectDBXDocument)) filename)))) dbx)
 )
)
;;----------------------------------------------------=={ ObjectDBX Document }==---------------------------------------------------------;;
;;                                                                                                                                       ;;
;;  Retrieves a version specific ObjectDBX Document object                                                                               ;;
;;                                                                                                                                       ;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] , Copyright © 2010 by Lee McDonnell, All Rights Reserved.                              ;;
;;  Contact: Lee @ lee-mac.com , Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com                                                  ;;
;;                                                                                                                                       ;;
;;  Arguments:  - None -                                                                                                                 ;;
;;  Returns:  VLA ObjectDBX Document Object, else nil                                                                                    ;;
;;---------------------------------------------------------------------------------------------------------------------------------------;;
(defun LM:ObjectDBXDocument (/ acVer)
 (vla-GetInterfaceObject (vlax-get-acad-object)
   (if (< (setq acVer (atoi (getvar "ACADVER"))) 16) "ObjectDBX.AxDbDocument" (strcat "ObjectDBX.AxDbDocument." (itoa acVer)))))

;;----------------------------------------------------------=={ Itemp }==----------------------------------------------------------------;;
;;                                                                                                                                       ;;
;;  Retrieves the item with index 'item' if present in the specified collection, else nil                                                ;;
;;                                                                                                                                       ;;
;;  Author: Lee McDonnell, 2010 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url] , Copyright © 2010 by Lee McDonnell, All Rights Reserved.                              ;;
;;  Contact: Lee @ lee-mac.com , Forums: Lee Mac @ TheSwamp.org, CADTutor.net, AUGI.com                                                  ;;
;;                                                                                                                                       ;;
;;  Arguments:  coll - the VLA Collection Object , item - the index of the item to be retrieved                                          ;;
;;  Returns:  the VLA Object at the specified index, else nil                                                                            ;;
;;---------------------------------------------------------------------------------------------------------------------------------------;;
(defun LM:Itemp (coll item) (if (not (vl-catch-all-error-p (setq item (vl-catch-all-apply (function vla-item) (list coll item))))) item))

(vl-load-com)
(princ)

Edited April 16, 2018 by rlx

April 16, 2018

Nice one guys, Thanks heaps so far.

And Happy bday Lee....

Right-e-o i have had a look over Lee Mac's CB lisp but i'm not that good with lisps at the moment to fully understand what is going on in it.

Can i pick your brains guys to let me know what is going on?

Firstly, is it normal to not be able to "interface with the drawing" if someone has it open?

Secondly, where can i modify it so that is automatically selects a particular block from my "Master" drawing rather than selecting the drawing, then selecting the block from a dialog box of block?

Any help would be super or point me in the direction where i can find more info on this lisp!

Ta heaps

Mark

If you're struggling with using the code give us the full path to the drawing that has the block in it and the block name. We could give you a CUI macro for inserting that block and you should be able to replace the paths and block names to create macros for other blocks. I'd write it using Lee's current StealV1-8.lsp, what version of Steal do you have? I don't believe it has any limitations as far as open drawings, but I've only used it on ones that were open by me.

Of course if you wblocked that block to it's own drawing all you would need is a simple -insert macro without any lisp at all.

Another way:

^C^C^P(command "adcnavigate" "G:/BeaufordT/Blocks/MUTCD.dwg")

uses a built in command that opens Design Center with MUTCD.dwg for me that has all the standard street signs in it as blocks. Many ways of doing anything in AutoCAD.

http://help.autodesk.com/view/ACD/2019/ENU/?guid=GUID-FE421165-22DD-4030-AEC1-2A5B0934326A

April 17, 2018

Like tombu you can drive lee's steal via lisp passing it what to do without having to run the dialouge box so skipping any user entry.

; this steals all blocks
(load "stealV1-6.lsp")
(Steal "P:\\Autodesk\\c3d Templates\\xxxx.dwt" (list (list "Blocks" "*")))

April 17, 2018

Tried it, after 10 mins cancelled out of it assuming didn't work.

Cheers Lee!!!

code (not mine) is quite slow to start , 2 minutes or so?, and could probably be programmed more efficiently , but the end result looks nice...

Lee

;-------------------------------------------------------------------------------
; Program Name: FireWorks.lsp [FireWorks R2] - AutoLISP graphics animation Created By: Terry Miller
; (Email: [email="terrycadd@yahoo.com"]terrycadd@yahoo.com[/email]) (URL: [url]http://web2.airmail.net/terrycad[/url]) (File: [url]http://web2.airmail.net/terrycad/LISP/FireWorks.lsp[/url])
; Date Created: 7-1-08
; Notes: FireWorks is an AutoLISP graphics animation program. It can be run inside of an existing drawing. When it's finished, it purges
; the layer FireWorks and all entities it created. Press P to pause the animation, or press Q to quit in order to purge the layer and
; entities it created. If you pressed the escape key to abort, you can simply rerun FireWorks again and press Q to quit. So do not
; press the escape key to abort the animation.
; Disclaimer:   This program is free to download and share and learn from. It contains many useful functions that may be applied else where.
;               Every effort on my part has been to create a graphics animation that will run in most versions of AutoCAD, and when finished it
;               will return to the environment before it started. FireWorks is now yours to tweak, debug, add to, rename, use parts of, or create
;               another graphics animation from. It is now your responsibility when, and within what drawings you should run it. If you are
;               unsure of how it may affect certain drawing environments, do a saveas before running it. Do not save a drawing without running
;               FireWorks and pressing Q to quit.
;-------------------------------------------------------------------------------
; Revision History
; Rev  By     Date    Description
;-------------------------------------------------------------------------------
; 1    TM   7-1-08    Initial version.
; 2    TM   7-3-08    Revised function to use less blocks more efficiently, and
;                     added a delay between FireWorks displays.
;-------------------------------------------------------------------------------
; c:FireWorks - FireWorks AutoLISP graphics animation program
;-------------------------------------------------------------------------------
(defun c:FW () (load "FireWorks") (c:FireWorks)) ;Shortcut
(defun c:FireWorks  (/ Block$ BlockA1$ BlockA2$ BlockB1$ BlockB2$ BlockC1$ BlockC2$ BlockD1$ BlockD2$ BlockE1$ BlockE2$ BlockF1$ BlockF2$ BlockG1$
                    BlockG2$ BlockH1$ BlockH2$ BlockI1$ BlockI2$ BlockJ1$ BlockJ2$ BlockK1$ BlockK2$ BlockL1$ BlockL2$ Blocks@ Class# Clayer$
                    Cnt# Cnt1# Cnt2# Cnt3# Cnt4# Cnt5# Cnt6# Cnt7# Cnt8# Cnt9# Cnt10# Cnt11# Cnt12# Code# Color1# Color2# Dia~ Ent1^ Ent2^ Ent3^
                    Ent4^ Ent5^ Ent6^ Ent7^ Ent8^ Ent9^ Ent10^ Ent11^ Ent12^ FireWorks: HRange InsBase InsScales@ Int# List@ LLpt LMpt Loop LRpt
                    MoveWorks: Moving MultiColors@ Num# Num1# Num2# Order@ Osmode# P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 RangeIns Read@
                    SingleColors@ SS& SubLoop Temp@ Total# ULpt UMpt Unique Unique$ UniqueName$ Uniques@ Unit~ URpt Value ViewCtr ViewExtents@
                    ViewSize~ ViewWidth~ VRange)
 ;-----------------------------------------------------------------------------
 ; FireWorks: - Draws FireWorks - Arguments: 4 - Ins = Insertion point, Dia~ = Diameter, Color1# = Spark color, Color2# = Trailing color
 ; Returns: Draws FireWorks and returns a list of the block names created.
 ;-----------------------------------------------------------------------------
 (defun FireWorks:  (Ins Dia~ Color1# Color2# / Ang~ AngChg~ Block1$ Block2$ Block3$ Block4$ Cen Cnt# Color3# Color4# ColorA1# ColorA2# ColorA3#
                     ColorA4# ColorB1# ColorB2# ColorB3# ColorB4# Left# Len~ Num# P1 P2 P3 Rad~ Right# RndColor RndColors: SS1& SS2& SS3& SS4&
                     TwoColors UniqueName$ Unit~ Vortex)
   (defun RndColors:  ()
     (setq Color1# (* 10 (1+ (RndInt 23))) Color2# Color1#)
     (while (< (abs (- Color1# Color2#)) 30) (setq Color2# (* 10 (1+ (RndInt 23))))) ;while
     (setq Color2# (+ Color2# 4) Color3# (+ Color1#   Color4# (+ Color2# 5))
     (if TwoColors
       (if (IsEven (/ Cnt# 2))
         (if (not ColorB1#) (setq ColorB1# Color1# ColorB2# Color2# ColorB3# Color3# ColorB4# Color4#)
                            (setq Color1# ColorB1# Color2# ColorB2# Color3# ColorB3# Color4# ColorB4#))
         (if (not ColorA1#) (setq ColorA1# Color1# ColorA2# Color2# ColorA3# Color3# ColorA4# Color4#)
                            (setq Color1# ColorA1# Color2# ColorA2# Color3# ColorA3# Color4# ColorA4#)))))
   (if (not Color1#)
     (progn (setq RndColor t) (if (not Color2#)(setq TwoColors t))) (setq Color3# (+ Color1#  Color4# (+ Color2# 5)))
   (setq Unit~ (/ Dia~ 80.0) Vortex (polar Ins (d2r 90) (* Unit~ 9)) Cen (polar Ins (d2r 90) (* Unit~ 9)) SS1& (ssadd) SS2& (ssadd) SS3& (ssadd)
         SS4& (ssadd) Right# 4 Left# 6 Ang~ 30 Num# 0 Cnt# 0 AngChg~ 7.5 Cen (polar Cen (d2r 270) (* Unit~ 3)) Rad~ (* Unit~ 9))
   (while (<= Ang~ 90)
     (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0))))) Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01)
           P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~) (* Len~ (1+ (RndInt 9)) 0.1))) P2 (polar P1 (angle Vortex P1) (* Len~ 0.75))
           P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
     (if RndColor (RndColors:))
     (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color4# "") (if (IsEven Cnt#) (ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
     (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color3# "") (if (IsEven Cnt#) (ssadd (entlast) SS2&) (ssadd (entlast) SS4&))
     (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color2# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
     (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color1# "") (if (IsEven Cnt#) (ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
     (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~) Ang~ (r2d (d2r Ang~)) Cnt# (1+ Cnt#))
   )
   (setq Cen (polar Ins (d2r 90) (* Unit~ 9)))
   (while (< (setq Num# (1+ Num#)) 
     (setq Cen (polar Cen (d2r 270) (* Unit~ 3)) Rad~ (* Unit~ (setq Right# (+ Right# 5))) AngChg~ (- AngChg~ 0.5))
     (while (<= Ang~ 270)
       (if (<= Ang~ 180)(setq Len~ (+ Unit~ (* Unit~ (* 2 (/ (- Ang~ 90) 90.0))))) (setq Len~ (+ (* Unit~ 3) (* Unit~ (* 2 (/ (- Ang~ 180) 90.0))))))
       (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01) P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~) (* Len~ (1+ (RndInt 9)) 0.1)))
             P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)) P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
       (if RndColor (RndColors:))
       (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color4# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
       (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color3# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
       (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color2# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
       (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color1# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
       (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~) Ang~ (r2d (d2r Ang~)) Cnt# (1+ Cnt#))
     )
     (if (/= Num# 7)
       (progn
         (setq Cen (polar Cen (d2r 90) (* Unit~ 2)) Rad~ (* Unit~ (setq Left# (+ Left# 5))) AngChg~ (- AngChg~ 0.5))
         (while (or (>= Ang~ 270) (<= Ang~ 90))
           (if (<= Ang~ 90)
             (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0)))))) (setq Len~ (+ (* Unit~ 3) (* Unit~ (- 2 (* 2 (/ (- Ang~ 270) 90.0)))))))
           (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01) P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~) (* Len~ (1+ (RndInt 9)) 0.1)))
                 P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)) P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
           (if RndColor (RndColors:))
           (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color4# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
           (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color3# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
           (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color2# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
           (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color1# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
           (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~) Ang~ (r2d (d2r Ang~)) Cnt# (1+ Cnt#)))))
     (setq Vortex (polar Vortex (d2r 90) (* Unit~ 2)))
   ) 
   (setq AngChg~ (- AngChg~ 0.5))
   (while (or (>= Ang~ 270) (<= Ang~ 30))
     (if (<= Ang~ 90)
       (setq Len~ (+ Unit~ (* Unit~ (- 2 (* 2 (/ Ang~ 90.0)))))) (setq Len~ (+ (* Unit~ 3) (* Unit~ (- 2 (* 2 (/ (- Ang~ 270) 90.0)))))))
     (setq Len~ (* Len~ (+ 90 (1+ (RndInt 9))) 0.01) P1 (polar Cen (d2r Ang~) (+ (- Rad~ Len~) (* Len~ (1+ (RndInt 9)) 0.1)))
           P2 (polar P1 (angle Vortex P1) (* Len~ 0.75)) P3 (polar P2 (angle Vortex P2) (* Len~ 0.25)))
     (if RndColor (RndColors:))
     (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color4# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
     (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color3# "") (if (IsEven Cnt#)(ssadd (entlast) SS2&)(ssadd (entlast) SS4&))
     (command "line" P1 P2 "" "chprop" (entlast) "" "c" Color2# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
     (command "line" P2 P3 "" "chprop" (entlast) "" "c" Color1# "") (if (IsEven Cnt#)(ssadd (entlast) SS1&)(ssadd (entlast) SS3&))
     (setq Ang~ (+ Ang~ (/ 10.0 Rad~) (RndInt 5) AngChg~) Ang~ (r2d (d2r Ang~)) Cnt# (1+ Cnt#))
   )
   (setq UniqueName$ (UniqueName) Block1$ (strcat UniqueName$ "1")) (command "block" Block1$ Ins SS1& "") (setq Block2$ (strcat UniqueName$ "2"))
   (command "block" Block2$ Ins SS2& "") (setq Block3$ (strcat UniqueName$ "3")) (command "block" Block3$ Ins SS3& "")
   (setq Block4$ (strcat UniqueName$ "4")) (command "block" Block4$ Ins SS4& "")(list Block1$ Block2$ Block3$ Block4$)
 ) ;defun FireWorks:
 ; MoveWorks: - Moves FireWorks
 ; Arguments: 7  Pt = Last scaled point, EntName^ = Entity name of block, Cnt# = Counter value of FireWork, Block1$ = Exploding block name
 ;               Block2$ = Fading block name, Mirror = t or nil to mirror block, InsAngle~ = Insertion angle
 ; Returns: Moves FireWork and returns a list of the next Pt and EntName^.;-----------------------------------------------------------------------------
 (defun MoveWorks:  (Pt EntName^ Num# Block1$ Block2$ Mirror InsAngle~ / Dist~ EntList@ InsPt List@ Scale1~ Scale2~)
   (if (= Num# 0)
     (progn (if Mirror (setq Scale1~ -0.1 Scale2~ 0.1) (setq Scale1~ 0.1 Scale2~ 0.1))
            (command "insert" Block1$ Pt Scale1~ Scale2~ InsAngle~) (setq EntName^ (entlast))))
   (if (= Num# 15)
     (progn (setq EntList@ (entget EntName^) InsPt (cdr (assoc 10 EntList@)) Scale2~ (abs (cdr (assoc 41 EntList@))))
            (if Mirror (setq Scale1~ (* Scale2~ -1)) (setq Scale1~ Scale2~)) (command "erase" EntName^ "")
            (command "insert" Block2$ InsPt Scale1~ Scale2~ InsAngle~)(setq EntName^ (entlast))))
   (if (and (>= Num# 0) (< Num# (length InsScales@)))
     (progn (setq List@ (nth Num# InsScales@) Scale1~ (nth 1 List@) Dist~ (* (nth 0 List@) Dia~) Pt (polar Pt (d2r 90) Dist~))
            (command "scale" EntName^ "" Pt Scale1~)))(if (= Num# (length InsScales@)) (command "erase" EntName^ ""))
   (list Pt EntName^)
 );defun MoveWorks:
 
 ; Start of Main Function
 (setq InsScales@  (list (list 0.00110000 1.90856943)(list 0.00449390 1.45507457)(list 0.00718449 1.29831044)(list 0.01030948 1.21861287)
                         (list 0.01397743 1.17020200)(list 0.01832986 1.13754799)(list 0.02355727 1.11392604)(list 0.02992505 1.09594905)
                         (list 0.03779755 1.08172391)(list 0.04769797 1.07010796)(list 0.06040343 1.06036909)(list 0.07709087 1.05201493)
                         (list 0.09962908 1.04470041)(list 0.13111964 1.03817470)(list 0.17703691 1.03224916)(list 0.24777800 1.02677702)
                         (list 0.36515870 1.02164006)(list 0.58168146 1.01673937)(list 1.05262733 1.01198870)))
 (setq Order@ (list 1 2 1 2 3 4 3 4 1 2 1 2 3 4 3 4 1 2 1 2 3 4 3 4))
 (setvar "cmdecho" 0)(if (/= (getvar "ctab") "Model")(command "pspace"))(command "undo" "begin")(gc)
 (setq ViewExtents@ (ViewExtents) ULpt (car ViewExtents@) LRpt (cadr ViewExtents@) LLpt (list (car ULpt) (cadr LRpt))
       URpt (list (car LRpt) (cadr ULpt)) ViewSize~ (getvar "viewsize") Unit~ (/ ViewSize~ 100.0) ViewWidth~ (distance ULpt URpt)
       ViewCtr (getvar "viewctr") UMpt (list (car ViewCtr) (cadr ULpt)) LMpt (list (car ViewCtr) (cadr LLpt)) VRange 37
       HRange (fix (/ (- ViewWidth~ (* Unit~ 56)) Unit~)))
 (if (IsEven HRange)(setq HRange (1- HRange)))
 (setq RangeIns (polar LLpt 0 (* Unit~ 28)) RangeIns (polar RangeIns (d2r 90) (* Unit~ 47)) InsBase (polar UMpt (d2r 90) ViewSize~)
       Dia~ (* Unit~ 50) Osmode# (getvar "osmode"))
 (setvar "osmode" 0) (setvar "blipmode" 0)(setq Clayer$ (getvar "clayer"))
 (if (tblsearch "layer" "FireWorks")
   (command "layer" "t" "FireWorks" "u" "FireWorks" "on" "FireWorks" "s" "FireWorks" "")(command "layer" "m" "FireWorks" "c" 250 "" ""))
 (if (setq SS& (ssget "x" (list '(8 . "FireWorks")))) (command "erase" SS& ""))(setq Block$ (strcat (substr (UniqueName) 1 5) "*"))
 (command "purge" "bl" Block$ "n")(repeat 40 (princ (strcat "\n" (chr 160))))
 (princ "\nCreating FireWorks...   1% Complete\010\010\010\010\010\010\010\010\010\010")(princ)
 (setq Class# 1 Int# 1 Total# 24)
 (while (< (length MultiColors@) 24)
   (if (IsEven Class#)
     (if (or (= Class# 2) (= Class# 6)) (setq Color1# nil Color2# nil) (setq Color1# nil Color2# t))
     (progn
       (setq Unique nil)
       (while (not Unique)
         (setq Color1# (* 10 (1+ (RndInt 23))) Color2# Color1#)
         (while (< (abs (- Color1# Color2#)) 30) (setq Color2# (* 10 (1+ (RndInt 23)))))
         (setq Color2# (+ Color2# 4) Unique$ (strcat (itoa Color1#) "-" (itoa Color2#)))
         (if (not (member Unique$ Uniques@)) (progn (setq Uniques@ (append Uniques@ (list Unique$))) (setq Unique t))))
     )
   )
   (setq Blocks@ (FireWorks: InsBase Dia~ Color1# Color2#))
   (if (IsEven Class#)
     (setq MultiColors@ (append MultiColors@ (list (nth 0 Blocks@) (nth 1 Blocks@))))
     (setq SingleColors@ (append SingleColors@ (list (nth 0 Blocks@) (nth 1 Blocks@)))))
   (setq Class# (1+ Class#)) (if (= Class# 9)(setq Class# 1)) (setq Num# (fix (/ Int# (* Total# 0.01))))
   (cond ((< Num# 10) (princ "\010"))((< Num# 100) (princ "\010\010"))((>= Num# 100) (princ "\010\010\010")))
   (princ (itoa Num#)) (princ) (setq Int# (1+ Int#))
 );while
 (command "delay" 100) (repeat 5 (princ (strcat "\n" (chr 160)))) (princ "\nFireWorks - Press P to pause, or Q to quit. ") (princ)
 (setq Loop t Class# 1)
 (while Loop
   (setq Blocks@ nil)
   (cond ((= Class# 1) ;One Single Color
          (setq Num# (* (RndInt 11) 2) UniqueName$ (nth Num# SingleColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (foreach Int# Order@ (setq Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)))))
         ((= Class# 2) ;One Two-Colors
          (setq Num# (* (RndInt 5) 4) UniqueName$ (nth Num# MultiColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (foreach Int# Order@ (setq Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)))))
         ((= Class# 3) ;Two Single Colors
          (setq Num1# (* (RndInt 11) 2) SubLoop t)
          (while SubLoop (setq Num2# (* (RndInt 11) 2)) (if (/= Num2# Num1#) (setq SubLoop nil)))(setq Cnt# 0)
          (foreach Int# Order@
            (if (IsEven Cnt#)(setq Num# Num2#)(setq Num# Num1#))
            (setq UniqueName$ (nth Num# SingleColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$)))
                  Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)) Cnt# (1+ Cnt#))))
         ((= Class# 4) ;One Multi-Colors
          (setq Num# (+ 2 (* (RndInt 5) 4)) UniqueName$ (nth Num# MultiColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (foreach Int# Order@ (setq Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)))))
         ((= Class# 5) ;One Single Color
          (setq Num# (* (RndInt 11) 2) UniqueName$ (nth Num# SingleColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$))))
          (foreach Int# Order@ (setq Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)))))
         ((= Class# 6) ;Random Two-Colors
          (repeat 2
            (setq Temp@ List@ List@ nil)
            (while (< (length List@) 6) (setq Num# (* (RndInt 5) 4))(if (not (member Num# List@))(setq List@ (append List@ (list Num#)))))
            (foreach Num# List@ (setq List@ (append List@ (list Num#)))))
          (foreach Num# Temp@ (setq List@ (append List@ (list Num#))))
          (setq Cnt# 0)
          (foreach Int#  Order@
            (setq Num# (nth Cnt# List@) UniqueName$ (nth Num# MultiColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$)))
                  Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)) Cnt# (1+ Cnt#))))
         ((= Class# 7) ;Two Single Colors
          (setq Num1# (* (RndInt 11) 2) SubLoop t)
          (while SubLoop (setq Num2# (* (RndInt 11) 2)) (if (/= Num2# Num1#)(setq SubLoop nil)))
          (setq Cnt# 0)
          (foreach Int# Order@
            (if (< Cnt# 4) (setq Num# Num2#)(setq Num# Num1#))
            (setq UniqueName$ (nth Num# SingleColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$)))
                  Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)) Cnt# (1+ Cnt#))
            (if (= Cnt#  (setq Cnt# 0))))
         ((= Class#  ;Random Multi-Colors
          (repeat 2
            (setq Temp@ List@ List@ nil)
            (while (< (length List@) 6)(setq Num# (+ 2 (* (RndInt 5) 4)))(if (not (member Num# List@))(setq List@ (append List@ (list Num#)))))
            (foreach Num# List@ (setq List@ (append List@ (list Num#)))))
          (foreach Num# Temp@ (setq List@ (append List@ (list Num#)))) ;foreach
          (setq Cnt# 0)
          (foreach Int#  Order@
            (setq Num# (nth Cnt# List@) UniqueName$ (nth Num# MultiColors@) UniqueName$ (substr UniqueName$ 1 (1- (strlen UniqueName$)))
                  Block$ (strcat UniqueName$ (itoa Int#)) Blocks@ (append Blocks@ (list Block$)) Cnt# (1+ Cnt#))))
   ) ;cond
   (setq BlockA1$ (nth 0 Blocks@) BlockA2$ (nth 1 Blocks@) BlockB1$ (nth 2 Blocks@) BlockB2$ (nth 3 Blocks@) BlockC1$ (nth 4 Blocks@)
         BlockC2$ (nth 5 Blocks@) BlockD1$ (nth 6 Blocks@) BlockD2$ (nth 7 Blocks@) BlockE1$ (nth 8 Blocks@) BlockE2$ (nth 9 Blocks@)
         BlockF1$ (nth 10 Blocks@) BlockF2$ (nth 11 Blocks@) BlockG1$ (nth 12 Blocks@) BlockG2$ (nth 13 Blocks@) BlockH1$ (nth 14 Blocks@)
         BlockH2$ (nth 15 Blocks@) BlockI1$ (nth 16 Blocks@) BlockI2$ (nth 17 Blocks@) BlockJ1$ (nth 18 Blocks@) BlockJ2$ (nth 19 Blocks@)
         BlockK1$ (nth 20 Blocks@) BlockK2$ (nth 21 Blocks@) BlockL1$ (nth 22 Blocks@) BlockL2$ (nth 23 Blocks@))
   (setq P1 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P2 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P3 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P4 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P5 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P6 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P7 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P8 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P9 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P10 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P11 (polar RangeIns 0 (* Unit~ (RndInt HRange))) P12 (polar RangeIns 0 (* Unit~ (RndInt HRange)))
         P1 (polar P1 (d2r 90) (* Unit~ (RndInt VRange))) P2 (polar P2 (d2r 90) (* Unit~ (RndInt VRange)))
         P3 (polar P3 (d2r 90) (* Unit~ (RndInt VRange))) P4 (polar P4 (d2r 90) (* Unit~ (RndInt VRange)))
         P5 (polar P5 (d2r 90) (* Unit~ (RndInt VRange))) P6 (polar P6 (d2r 90) (* Unit~ (RndInt VRange)))
         P7 (polar P7 (d2r 90) (* Unit~ (RndInt VRange))) P8 (polar P8 (d2r 90) (* Unit~ (RndInt VRange)))
         P9 (polar P9 (d2r 90) (* Unit~ (RndInt VRange))) P10 (polar P10 (d2r 90) (* Unit~ (RndInt VRange)))
         P11 (polar P11 (d2r 90) (* Unit~ (RndInt VRange))) P12 (polar P12 (d2r 90) (* Unit~ (RndInt VRange))))
   (setq Cnt1#  -1 Cnt2#  (- Cnt1# 3) Cnt3#  (- Cnt2# 3) Cnt4#  (- Cnt3# 3) Cnt5#  (- Cnt4# 3) Cnt6#  (- Cnt5# 3) Cnt7#  (- Cnt6# 3)
         Cnt8#  (- Cnt7# 3) Cnt9#  (- Cnt8# 3) Cnt10# (- Cnt9# 3) Cnt11# (- Cnt10# 3) Cnt12# (- Cnt11# 3))
   (setq Moving t)
   (while Moving
     (command "zoom" LLpt URpt) (command "delay" 20)
     (setq Read@ (grread t 12 1) Code# (nth 0 Read@) Value (nth 1 Read@))
     (if (and (= Code# 2) (member Value (list 80 112))) ;P pressed
       (progn (getpoint "\nFireWorks paused.  Pick mouse to continue. ")(repeat 5 (princ (strcat "\n" (chr 160))))
              (command "zoom" LLpt URpt)(princ "\nFireWorks - Press P to pause, or Q to quit. ")(princ)))
     (if (and (= Code# 2) (member Value (list 81 113))) (setq Moving nil Loop nil)) ;Q pressed
     (command "zoom" LLpt URpt)
     (setq Cnt1# (1+ Cnt1#) Cnt2# (1+ Cnt2#) Cnt3# (1+ Cnt3#) Cnt4# (1+ Cnt4#) Cnt5# (1+ Cnt5#) Cnt6# (1+ Cnt6#) Cnt7# (1+ Cnt7#) Cnt8#  (1+ Cnt8#)
           Cnt9# (1+ Cnt9#) Cnt10# (1+ Cnt10#) Cnt11# (1+ Cnt11#) Cnt12# (1+ Cnt12#))
     (setq List@ (MoveWorks: P1 Ent1^ Cnt1# BlockA1$ BlockA2$ nil 0) P1 (nth 0 List@) Ent1^ (nth 1 List@))
     (setq List@ (MoveWorks: P2 Ent2^ Cnt2# BlockB1$ BlockB2$ t +3) P2 (nth 0 List@) Ent2^ (nth 1 List@))
     (setq List@ (MoveWorks: P3 Ent3^ Cnt3# BlockC1$ BlockC2$ nil 0))
     (setq P3 (nth 0 List@) Ent3^ (nth 1 List@) List@ (MoveWorks: P4 Ent4^ Cnt4# BlockD1$ BlockD2$ t -3))
     (setq P4 (nth 0 List@) Ent4^ (nth 1 List@) List@ (MoveWorks: P5 Ent5^ Cnt5# BlockE1$ BlockE2$ nil +3))
     (setq P5 (nth 0 List@) Ent5^ (nth 1 List@) List@ (MoveWorks: P6 Ent6^ Cnt6# BlockF1$ BlockF2$ t 0))
     (setq P6 (nth 0 List@) Ent6^ (nth 1 List@) List@ (MoveWorks: P7 Ent7^ Cnt7# BlockG1$ BlockG2$ nil -3))
     (setq P7 (nth 0 List@) Ent7^ (nth 1 List@) List@ (MoveWorks: P8 Ent8^ Cnt8# BlockH1$ BlockH2$ t 0))
     (setq P8 (nth 0 List@) Ent8^ (nth 1 List@) List@ (MoveWorks: P9 Ent9^ Cnt9# BlockI1$ BlockI2$ nil 0))
     (setq P9 (nth 0 List@) Ent9^ (nth 1 List@) List@ (MoveWorks: P10 Ent10^ Cnt10# BlockJ1$ BlockJ2$ t +3))
     (setq P10 (nth 0 List@) Ent10^ (nth 1 List@) List@ (MoveWorks: P11 Ent11^ Cnt11# BlockK1$ BlockK2$ nil 0))
     (setq P11 (nth 0 List@) Ent11^ (nth 1 List@) List@ (MoveWorks: P12 Ent12^ Cnt12# BlockL1$ BlockL2$ t -3))
     (setq P12 (nth 0 List@) Ent12^ (nth 1 List@))
     (if (= Cnt12# (+ (length InsScales@) 2)) (setq Moving nil))
   );while
   (setq Class# (1+ Class#))(if (= Class# 9) (setq Class# 1))(command "delay" 200);Adjust delay between displays as needed
 );while
 (command "undo" "end")(setvar "osmode" Osmode#)(setvar "clayer" Clayer$)
 (if (= (getvar "clayer") "FireWorks")(command "layer" "t" "0" "u" "0" "on" "0" "s" "0" ""))
 (if (setq SS& (ssget "x" (list '(8 . "FireWorks"))))(command "erase" SS& ""))
 (setq Block$ (strcat (substr (UniqueName) 1 5) "*"))(command "purge" "bl" Block$ "n")(command "purge" "la" "FireWorks" "n")
 (repeat 40(princ (strcat "\n" (chr 160))))(princ "\nFireWorks objects cleared.")
 (princ)
);defun c:FireWorks
; Start of FireWorks Support Utility Functions
; RndInt - Generates a random integer, Arguments: 1  Num# = Maximum random integer number range greater than or less than 0
; Returns: Random integer number between 0 and Num#.
(defun RndInt  (Num# / Half~ Loop MaxNum# Minus PiDate$ RndNum#)
 (if (or (/= (type Num#) 'INT) (= Num# 0))
   (progn (princ "\nSyntax: (RndInt Num#) Num# = Maximum random integer number range\ngreater than or less than 0.")(exit)))
 (if (< Num# 0)(setq MaxNum# (abs (1- Num#)) Minus   t)(setq MaxNum# (1+ Num#)))
 (setq Half~ (/ (1- MaxNum#) 2.0)) (if (not *RndNum*)(setq *RndNum* 10000)) (if (not *Int*)(setq *Int* 1))(setq Loop t)
 (while Loop
   (if (> *Int* 50)(setq *Int* 1)(setq *Int* (1+ *Int*)))
   (setq PiDate$ (rtos (* (getvar "cdate") (* pi *Int*)) 2 )
   (cond
     ((>= MaxNum# 10000)  (setq RndNum# (fix (* (atof (substr PiDate$ 13 5)) (* MaxNum# 0.00001)))))
     ((>= MaxNum# 1000)  (setq RndNum# (fix (* (atof (substr PiDate$ 14 4)) (* MaxNum# 0.0001)))))
     ((>= MaxNum# 100) (setq RndNum# (fix (* (atof (substr PiDate$ 15 3)) (* MaxNum# 0.001)))))
     ((>= MaxNum# 10) (setq RndNum# (fix (* (atof (substr PiDate$ 16 2)) (* MaxNum# 0.01)))))
     ((>= MaxNum# 1) (setq RndNum# (fix (* (atof (substr PiDate$ 17 1)) (* MaxNum# 0.1)))))
     (t (setq RndNum# 0)))
   (if
     (or (and (< RndNum# Half~) (< *RndNum* Half~)) (and (> RndNum# Half~) (> *RndNum* Half~)))
      (if (= (rem *Int* 2) 0)
        (setq RndNum# (- (1- MaxNum#) RndNum#))
        (if (> RndNum# Half~) (setq RndNum# (fix (- RndNum# Half~ 0.5)))(setq RndNum# (fix (+ RndNum# Half~ 0.5)))) ;if
        )                              ;if
      )                                ;if
   (if (/= RndNum# *RndNum*)
     (setq Loop nil))                  ;if
   )                                   ;while
 (setq *RndNum* RndNum#)
 (if Minus
   (setq RndNum# (* RndNum# -1)))      ;if
 RndNum#
);defun RndInt
; IsEven - Determines if a number is even or odd
; Arguments: 1 Num# = Number Returns: t if an even number else nil if an odd number
(defun IsEven (Num#) (= (rem Num# 2) 0))
; d2r - Degrees to radians in the range of 0 to less than 2pi
; Arguments: 1 Degrees = Angle in degrees Returns: Radians in the range of 0 to less than 2pi
(defun d2r  (Degrees / Radians)
 (while (< Degrees 0) (setq Degrees (- 360 (abs Degrees))))(while (>= Degrees 360) (setq Degrees (- Degrees 360)))
 (setq Radians (* pi (/ Degrees 180.0))) Radians)
; r2d - Radians to degrees in the range of 0 to less than 360 degrees
; Arguments: 1 Radians = Angle in radians Returns: Degrees in the range of 0 to less than 360 degrees
(defun r2d  (Radians / Degrees)
 (while (< Radians 0) (setq Radians (- (* pi 2) (abs Radians))))(while (>= Radians (* pi 2)) (setq Radians (- Radians (* pi 2))))
 (setq Degrees (* 180.0 (/ Radians pi))) Degrees)
; UniqueName - Creates a unique name for temp blocks and groups
(defun UniqueName  (/ Loop Name$)
 (setq Loop t)
 (while Loop
   (setq Name$ (rtos (getvar "CDATE") 2  Name$ (strcat (substr Name$ 4 5) (substr Name$ 10 ))
   (if (/= Name$ *UniqueName$) (setq *UniqueName$ Name$ Loop nil))) *UniqueName$)
;ViewExtents Returns: List of upper left and lower right points of current view
(defun ViewExtents  (/ A B C D X)
 (setq B (getvar "VIEWSIZE")  A (* B (/ (car (getvar "SCREENSIZE")) (cadr (getvar "SCREENSIZE"))))
       X (trans (getvar "VIEWCTR") 1 2) C (trans (list (- (car X) (/ A 2.0)) (+ (cadr X) (/ B 2.0))) 2 1)
       D (trans (list (+ (car X) (/ A 2.0)) (- (cadr X) (/ B 2.0))) 2 1)) (list C D))
(princ)
(c:FireWorks)

April 17, 2018

Handsome fellow

never seem to be able to embed an image in a thread but attachment will have to do...

April 17, 2018

Thanks guys,

I think i have a way forward

ATM i'm adding stuff to Lee Macs "Steals" lisp. as i've got some of my blocks added into the lisp and inserting them into the drawing automatically and is working yeah!!!

Now just need to add some command lines so that when i insert these block into the drawing they appear on the correct layers, so far i have:

(defun c:draft nil

(Steal "R:\\Drafting\\ATCW Standards\\ATCW Master.dwg"

'(

("Blocks" ("draft"))

(command "-layer" "a" "s" "draft" "" "" "")

(command "-layer" "n" "_draft" "c" "7" "" "m" "_draft" "" "")

(command "Insert" "draft" "0,0" "" "" "")

(command "-layer" "a" "r" "draft" "d" "draft" "" "")

)

Problem is i don't want to have to enter the "layer state" command every time i insert a new block. is there a simpler way?

I am researching this on the internet and looking through other lisps to work this out.......I might just get the hang of this one day

Good times!!!

Sign In

Grab block from one drawing and insert into another via a lisp

Recommended Posts

Mark_ATCW

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Dadgad

Posted Images

iconeo

Dadgad

iconeo

Mark_ATCW

Dadgad

rlx

Mark_ATCW

Dadgad

rlx

Dadgad

rlx

Mark_ATCW

BIGAL

rlx

tombu

BIGAL

Mark_ATCW

rlx

Mark_ATCW

Join the conversation

Dadgad

Tutorials

Forums

Activity