+ Reply to Thread
Page 2 of 3 FirstFirst 1 2 3 LastLast
Results 11 to 20 of 21
  1. #11
    Luminous Being Dadgad's Avatar
    Using
    AutoCAD 2013
    Join Date
    Nov 2011
    Location
    At the confluence of worthlessness & invaluability
    Posts
    6,030

    Default

    Registered forum members do not see this ad.

    Quote Originally Posted by rlx View Post
    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!
    Volume and repetition do not validate opinions forged in the absence of thought.

  2. #12
    Super Member rlx's Avatar
    Computer Details
    rlx's Computer Details
    Operating System:
    W10
    Computer:
    i74ghz/ssd500/2tbhdd
    Discipline
    Electrical
    rlx's Discipline Details
    Occupation
    electrical designer dragon
    Discipline
    Electrical
    Details
    I dont excel in anything but I rearly give up
    Using
    AutoCAD 2016
    Join Date
    Nov 2014
    Location
    Bergen op Zoom , Netherlands
    Posts
    941

    Default

    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


    Code:
    ;-------------------------------------------------------------------------------
    ; Program Name: FireWorks.lsp [FireWorks R2] - AutoLISP graphics animation Created By: Terry Miller
    ; (Email: terrycadd@yahoo.com) (URL: http://web2.airmail.net/terrycad) (File: http://web2.airmail.net/terrycad/LISP/FireWorks.lsp)
    ; 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# 8)  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# 8) 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#)) 8)
          (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# 8) (setq Cnt# 0))))
              ((= Class# 8) ;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 8))
        (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 8) Name$ (strcat (substr Name$ 4 5) (substr Name$ 10 8)))
        (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)
    Last edited by rlx; 13th Apr 2018 at 03:10 pm.

  3. #13
    Junior Member
    Discipline
    Civil
    Using
    Civil 3D 2016
    Join Date
    Mar 2018
    Posts
    10

    Default

    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

  4. #14
    Quantum Mechanic
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    10,399

    Default

    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.
    Attached Images
    A man who never made mistakes never made anything

  5. #15
    Super Member rlx's Avatar
    Computer Details
    rlx's Computer Details
    Operating System:
    W10
    Computer:
    i74ghz/ssd500/2tbhdd
    Discipline
    Electrical
    rlx's Discipline Details
    Occupation
    electrical designer dragon
    Discipline
    Electrical
    Details
    I dont excel in anything but I rearly give up
    Using
    AutoCAD 2016
    Join Date
    Nov 2014
    Location
    Bergen op Zoom , Netherlands
    Posts
    941

    Default

    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) :


    Code:
    ;;  Author: Lee McDonnell, 2010 - www.lee-mac.com 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 - www.lee-mac.com , 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 - www.lee-mac.com , 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 - www.lee-mac.com , 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)
    Last edited by rlx; 16th Apr 2018 at 09:50 am.

  6. #16
    Super Member
    Computer Details
    tombu's Computer Details
    Operating System:
    Windows 7 64-bit
    Computer:
    Dell
    Discipline
    Civil
    tombu's Discipline Details
    Occupation
    Design Analyst
    Discipline
    Civil
    Details
    Small Street & Stormwater projects. Traffic Calming and other issues.
    Using
    Civil 3D 2018
    Join Date
    Dec 2010
    Location
    Tallahassee, FL USA
    Posts
    779

    Default

    Quote Originally Posted by Mark_ATCW View Post
    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:
    Code:
    ^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/20...1-2A5B0934326A
    Layer 0 for ByBlock Block entities, everything else ByLayer. So many issues can be solved with good templates.

  7. #17
    Quantum Mechanic
    Using
    Civil 3D 2016
    Join Date
    Dec 2005
    Location
    GEELONG AUSTRALIA
    Posts
    10,399

    Default

    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.

    Code:
    ; this steals all blocks
    (load "stealV1-6.lsp")
    (Steal "P:\\Autodesk\\c3d Templates\\xxxx.dwt" (list (list "Blocks" "*")))
    A man who never made mistakes never made anything

  8. #18
    Junior Member
    Discipline
    Civil
    Using
    Civil 3D 2016
    Join Date
    Mar 2018
    Posts
    10

    Default

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


    Quote Originally Posted by rlx View Post
    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


    Code:
    ;-------------------------------------------------------------------------------
    ; Program Name: FireWorks.lsp [FireWorks R2] - AutoLISP graphics animation Created By: Terry Miller
    ; (Email: terrycadd@yahoo.com) (URL: http://web2.airmail.net/terrycad) (File: http://web2.airmail.net/terrycad/LISP/FireWorks.lsp)
    ; 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# 8)  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# 8) 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#)) 8)
          (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# 8) (setq Cnt# 0))))
              ((= Class# 8) ;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 8))
        (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 8) Name$ (strcat (substr Name$ 4 5) (substr Name$ 10 8)))
        (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)

  9. #19
    Super Member rlx's Avatar
    Computer Details
    rlx's Computer Details
    Operating System:
    W10
    Computer:
    i74ghz/ssd500/2tbhdd
    Discipline
    Electrical
    rlx's Discipline Details
    Occupation
    electrical designer dragon
    Discipline
    Electrical
    Details
    I dont excel in anything but I rearly give up
    Using
    AutoCAD 2016
    Join Date
    Nov 2014
    Location
    Bergen op Zoom , Netherlands
    Posts
    941

    Default

    Handsome fellow


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

  10. #20
    Junior Member
    Discipline
    Civil
    Using
    Civil 3D 2016
    Join Date
    Mar 2018
    Posts
    10

    Default

    Registered forum members do not see this ad.

    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!!!

Similar Threads

  1. turn macro script to a lisp for insert block from another drawing
    By tive29 in forum AutoLISP, Visual LISP & DCL
    Replies: 6
    Last Post: 13th Jun 2017, 03:46 am
  2. How do I grab items from one drawing but NOT all the styles?
    By envisionman in forum CAD Management
    Replies: 8
    Last Post: 27th Sep 2016, 08:39 pm
  3. LISP Code To Insert Block To a Drawing Template
    By erickson19886 in forum AutoLISP, Visual LISP & DCL
    Replies: 5
    Last Post: 7th Sep 2016, 07:09 am
  4. LISP to Grab Layer from a block
    By rwsice9 in forum AutoLISP, Visual LISP & DCL
    Replies: 14
    Last Post: 3rd May 2013, 08:51 pm
  5. Insert a block by lisp: _.insert or another way?
    By MarcoW in forum AutoLISP, Visual LISP & DCL
    Replies: 11
    Last Post: 3rd Nov 2010, 10:40 am

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts