home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 6.img / SUPPORT4.LIB / 3DARRAY.LSP next >
Encoding:
Text File  |  1993-02-09  |  7.8 KB  |  287 lines
  1. ;;;   3DARRAY.LSP
  2. ;;;
  3. ;;;   ¬⌐┼v (C) 1987-1992  Autodesk ñ╜Ñq
  4. ;;;
  5. ;;;   Ñ╗│n┼ΘºK╢O¿╤▒z╢iªµÑ⌠ª≤Ñ╬│~╗▌¿D¬║½■¿⌐íB¡╫º∩ñ╬╡oªµ, ª²¼O░╚╜╨┐φ┤`ñU¡z
  6. ;;;   ¡∞½h :
  7. ;;;
  8. ;;;   1)  ñWªC¬║¬⌐┼v│qºi░╚╗▌ÑX▓{ªb¿Cñ@Ñ≈½■¿⌐∙╪íC
  9. ;;;   2)  ¼█├÷¬║╗í⌐·ñσÑ≤ñ]Ñ▓╢╖⌐·╕ⁿ¬⌐┼v│qºiñ╬Ñ╗╢╡│\Ñi│qºiíC
  10. ;;;
  11. ;;;   Ñ╗│n┼Θ╢╚┤ú¿╤º@¼░└│Ñ╬ñW¬║░╤ª╥, ª╙Ñ╝┴n⌐·⌐╬┴⌠ºtÑ⌠ª≤½O├╥; ╣∩⌐≤Ñ⌠ª≤»S«φ
  12. ;;;   Ñ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºtÑX¿π¬║½O├╥, ªbª╣ñ@╖ºñ⌐ÑHº_╗{íC
  13. ;;;
  14. ;;;
  15. ;;;  Functions included:
  16. ;;;       1) Rectangular ARRAYS (rows, columns & levels)
  17. ;;;       2) Circular ARRAYS around any axis
  18. ;;;
  19. ;;;  All are loaded by: (load "3darray")
  20. ;;;
  21. ;;;  And run by:
  22. ;;;       Command: 3darray
  23. ;;;                Select objects:
  24. ;;;                Rectangular or Polar array (R/P): (select type of array)
  25. ;;;***********************************************************************
  26. ;;; ===========================================================================
  27. ;;; ===================== load-time error checking ============================
  28. ;;;
  29.  
  30.   (defun ai_abort (app msg)
  31.      (defun *error* (s)
  32.         (if old_error (setq *error* old_error))
  33.         (princ)
  34.      )
  35.      (if msg
  36.        (alert (strcat " Application error: "
  37.                       app
  38.                       " \n\n  "
  39.                       msg
  40.                       "  \n"
  41.               )
  42.        )
  43.      )
  44.      (exit)
  45.   )
  46.  
  47. ;;; Check to see if AI_UTILS is loaded, If not, try to find it,
  48. ;;; and then try to load it.
  49. ;;;
  50. ;;; If it can't be found or it can't be loaded, then abort the
  51. ;;; loading of this file immediately, preserving the (autoload)
  52. ;;; stub function.
  53.  
  54.   (cond
  55.      (  (and ai_dcl (listp ai_dcl)))          ; it's already loaded.
  56.  
  57.      (  (not (findfile "ai_utils.lsp"))                     ; find it
  58.         (ai_abort "3DARRAY"
  59.                   (strcat "Can't locate file AI_UTILS.LSP."
  60.                           "\n Check support directory.")))
  61.  
  62.      (  (eq "failed" (load "ai_utils" "failed"))            ; load it
  63.         (ai_abort "3DARRAY" "Can't load file AI_UTILS.LSP"))
  64.   )
  65.  
  66.   (if (not (ai_acadapp))               ; defined in AI_UTILS.LSP
  67.       (ai_abort "3DARRAY" nil)         ; a Nil <msg> supresses
  68.   )                                    ; ai_abort's alert box dialog.
  69.  
  70. ;;; ==================== end load-time operations ===========================
  71. ;;;
  72. ;;;******************************** MODES ********************************
  73. ;;;
  74. ;;; System variable save
  75.  
  76. (defun MODES (a)
  77.   (setq MLST '())
  78.   (repeat (length a)
  79.     (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  80.     (setq a (cdr a))
  81.   )
  82. )
  83.  
  84. ;;;******************************** MODER ********************************
  85. ;;;
  86. ;;; System variable restore
  87.  
  88. (defun MODER ()
  89.   (repeat (length MLST)
  90.     (setvar (caar MLST) (cadar MLST))
  91.     (setq MLST (cdr MLST))
  92.   )
  93. )
  94.  
  95. ;;;******************************** 3DAERR *******************************
  96. ;;;
  97. ;;; Standard error function
  98.  
  99. (defun 3DAERR (st)                    ; If an error (such as CTRL-C) occurs
  100.                                       ; while this command is active...
  101.   (if (/= st "íu¿τ╝╞ív¿·«°")
  102.       (princ (strcat "\n┐∙╗~: " s))
  103.   )
  104.   (command "_.UNDO" "_E")
  105.   (ai_undo_off)
  106.   (moder)                             ; Restore system variables
  107.   (setq *error* olderr)               ; Restore old *error* handler
  108.   (princ)
  109. )
  110.  
  111. ;;;******************************* P-ARRAY *******************************
  112. ;;;
  113. ;;; Perform polar (circular) array around any axis
  114.  
  115. (defun P-ARRAY (/ n af yn cen c ra)
  116.  
  117.   ;; Define number of items in array
  118.   (setq n 0)
  119.   (while (<= n 1)
  120.     (initget (+ 1 2 4))
  121.     (setq n (getint "\n╜╞╗s╝╞╢q: "))
  122.     (if (= n 1)
  123.       (prompt "\n╜╞╗s╝╞╢qÑ▓╢╖ > 1")
  124.     )
  125.   )
  126.  
  127.   ;; Define angle to fill
  128.   (initget 2)
  129.   (setq af (getreal "\n╣w│╞ñ└ºG¬║¿ñ½╫ <360>: "))
  130.   (if (= af nil) (setq af 360))
  131.  
  132.   ;; Are objects to be rotated?
  133.   (initget "Yes No")
  134.   (setq yn (getkword "\n¬½┼Θ½÷╖╙╜╞╗s½ß¬║¿ñ½╫íu▒█┬αív? <Y>: "))
  135.   (if (null yn)
  136.     (setq yn "Y")
  137.   )
  138.  
  139.   ;; Define center point of array
  140.   (initget 17)
  141.   (setq cen (getpoint "\níu└⌠º╬░}ªCívñññ▀┬I: "))
  142.   (setq c (trans cen 1 0))
  143.  
  144.   ;; Define rotational axis
  145.   (initget 17)
  146.   (setq ra (getpoint cen "\n▒█┬╢╢bíu▓─ 2 ┬Iív: "))
  147.   (while (equal ra cen)
  148.     (princ "\n┬Iª∞╡L«─; ▓─ 2 ┬IñúÑi╡Ñ⌐≤íuñññ▀┬IívíC")
  149.     (initget 17)
  150.     (setq ra (getpoint cen "\n╜╨ªA╕╒: "))
  151.   )
  152.   (setvar "UCSFOLLOW" 0)
  153.   (setvar "GRIDMODE" 0)
  154.   (command "_.UCS" "_ZAXIS" cen ra)
  155.   (setq cen (trans c 0 1))
  156.  
  157.   ;; Draw polar array
  158.   (command "_.ARRAY" ss "" "_P" cen n af yn)
  159.   (command "_.UCS" "_p")
  160. )
  161.  
  162. ;;;******************************* R-ARRAY *******************************
  163. ;;;
  164. ;;; Perform rectangular array
  165.  
  166. (defun R-ARRAY (/ nr nc nl flag x y z c el en ss2 e)
  167.  
  168.   ;; Set array parameters
  169.   (while (or (= nr nc nl nil) (= nr nc nl 1))
  170.     (setq nr 1)
  171.     (initget (+ 2 4))
  172.     (setq nr (getint "\n╛εªC╝╞ (---) <1>: "))
  173.     (if (null nr) (setq nr 1))
  174.     (initget (+ 2 4))
  175.     (setq nc (getint "\n¬╜ªµ╝╞ (|||) <1>: "))
  176.     (if (null nc) (setq nc 1))
  177.     (initget (+ 2 4))
  178.     (setq nl (getint "\n╝h╢Ñ╝╞ (...) <1>: "))
  179.     (if (null nl) (setq nl 1))
  180.     (if (= nr nc nl 1)
  181.       (princ "\níu│µñ@ñ╕┼Θív░}ªC, ñúñ⌐░⌡ªµíC\n╜╨ªA╕╒")
  182.     )
  183.   )
  184.   (setvar "ORTHOMODE" 1)
  185.   (setvar "HIGHLIGHT" 0)
  186.   (setq flag 0)                       ; Command style flag
  187.   (if (/= nr 1)
  188.     (progn
  189.     (initget (+ 1 2))
  190.     (setq y (getdist "\n╛εªC╢í╢Z (---): "))
  191.     (setq flag 1)
  192.     )
  193.   )
  194.   (if (/= nc 1)
  195.     (progn
  196.     (initget (+ 1 2))
  197.     (setq x (getdist "\n¬╜ªµ╢í╢Z (|||): "))
  198.     (setq flag (+ flag 2))
  199.     )
  200.   )
  201.   (if (/= nl 1)
  202.     (progn
  203.     (initget (+ 1 2))
  204.     (setq z (getdist "\n╝h╢Ñ╢í╢Z (...): "))
  205.     )
  206.   )
  207.   (setvar "BLIPMODE" 0)
  208.  
  209.   (setq c 1)
  210.   (setq el (entlast))                 ; Reference entity
  211.   (setq en (entnext el))
  212.   (while (not (null en))
  213.     (setq el en)
  214.     (setq en (entnext el))
  215.   )
  216.  
  217.   ;; Copy the selected entities one level at a time
  218.   (while (< c nl)
  219.     (command "_.COPY" ss "" "0,0,0" (append (list 0 0) (list (* c z)))
  220.     )
  221.     (setq c (1+ c))
  222.   )
  223.  
  224.   (setq ss2 (ssadd))                  ; create a new selection set
  225.   (setq e (entnext el))               ; of all the new entities since
  226.   (while e                            ; the reference entity.
  227.     (ssadd e ss2)
  228.     (setq e (entnext e))
  229.   )
  230.  
  231.   ;; Array original selection set and copied entities
  232.   (cond
  233.     ((= flag 1) (command "_.ARRAY" ss ss2 "" "_R" nr "1" y))
  234.     ((= flag 2) (command "_.ARRAY" ss ss2 "" "_R" "1" nc x))
  235.     ((= flag 3) (command "_.ARRAY" ss ss2 "" "_R" nr nc y x))
  236.   )
  237. )
  238.  
  239. ;;;***************************** MAIN PROGRAM ****************************
  240.  
  241. (defun C:3DARRAY (/ olderr ss xx undo_setting)
  242.   (if (and (= (getvar "cvport") 1) (= (getvar "tilemode") 0))
  243.     (progn
  244.       (prompt "\n *** íu╣╧»╚¬┼╢íívñUñúñ╣Ñ╬ª╣½ⁿÑO ***\n")
  245.       (princ)
  246.     )
  247.     (progn
  248.       (setq olderr *error*
  249.             *error* 3daerr
  250.       )
  251.       (modes '("cmdecho" "blipmode" "highlight" "orthomode"
  252.                "ucsfollow" "gridmode")
  253.       )
  254.       (setvar "CMDECHO" 0)
  255.  
  256.       (ai_undo_on)                    ; Turn UNOD on
  257.  
  258.       (command "_.UNDO" "_GROUP")
  259.       (graphscr)
  260.  
  261.       (setq ss nil)
  262.       (while  (null ss)               ; Ensure selection of entities
  263.         (setq ss (ssget))
  264.       )
  265.  
  266.       (initget 1 "Rectangular Polar Circular")
  267.       (setq xx (getkword "\níuR»xº╬ív⌐╬íuP└⌠º╬ív░}ªC (R/P): "))
  268.       (cond
  269.         ((eq xx "Rectangular")
  270.           (r-array)
  271.         )
  272.         (T
  273.           (p-array)
  274.         )
  275.       )
  276.       (command "_.UNDO" "_E")
  277.       (ai_undo_off)                   ; Return UNDO to initial state
  278.       (moder)                         ; Restore system variables
  279.       (setq *error* olderr)           ; Restore old *error* handler
  280.       (princ)
  281.     )
  282.   )
  283. )
  284.  
  285. (princ "  íu3DARRAYívñw╕ⁿñJíC")
  286. (princ)
  287.