home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / KRAMER.LSP < prev    next >
Text File  |  1989-09-10  |  12KB  |  304 lines
  1. ;  Dear AutoCAD User;
  2. ;
  3. ;  Below are a set of My favorite macros from the CADENCE series.
  4. ;  I recommend that they be separated into different files after
  5. ;  downloading from the BBS.  Best of luck and keep on PUDDERING!
  6. ;
  7. ;                             Bill Kramer Feb. 1987
  8. ;
  9. ; =================================================================
  10. ;   Side View Macro          SIDEVIEW.LSP
  11. ;   by:  Bill Kramer         CADENCE Vol1 #3 Sept 86
  12. ;
  13. ;      Functions:   SVSTRT   Initialize Siew View
  14. ;                   SVZSET   Set up the Z values for the side view
  15. ;                   SVLINE   Draw lines on top and side view
  16. ;==================================================================
  17. (prompt "\nLoading SIDEVIEW Macros.   (c)1986 Kramer Consulting, Inc.")
  18. (defun c:svstrt ()
  19.    (setq zbase (getreal "\nY axis value for Z=0 <0.0>: "))
  20.    (if (null zbase) (setq zbase 0.0))
  21.    (setvar "CMDECHO" 0)
  22. )
  23. ; -----------------------------------------------------------------
  24. (defun c:svzset ()
  25.    (setq tz (getreal "\nStarting Elevation bottom:")) ; Z1 value?
  26.    (cond ((null tz)  ; No entry, use CP or ZBASE values.
  27.              (if (null cp) ; Current point equal to nil?
  28.                    (setq pp (list zbase zbase)) ; Use base value.
  29.                    (setq pp cp) ; Set elevations from current point.
  30.              )
  31.          )
  32.          (t          ; User entry made, ask for Z2 value.
  33.              (setq pp (+ tz zbase)) ; Add offset to entry, put in PP.
  34.              (setq tz (getreal "\nStarting Elevation top:"))
  35.              (if (null tz); No Input read?
  36.                         (setq pp (list pp pp)) ; Use Bottom entry.
  37.                         (setq pp (list pp (+ tz zbase))) ;Add offset
  38.              )
  39.          )
  40.    )
  41.    (setq tz (getreal "\nEnding Elevation bottom:"))
  42.    (cond ((null tz) ; No user entry made, use previous point.
  43.                (setq cp pp)
  44.          )
  45.          (t  ; User made entry.
  46.              (setq cp (+ tz zbase)) ; Add offset and save in CP.
  47.              (setq tz (getreal "\nEnding Elevation top:"))
  48.              (if (null tz)  ; No input read?
  49.                       (setq cp (list cp cp)) ;Use bottom value for top.
  50.                       (setq cp (list cp (+ tz zbase))) ; Add offset.
  51.              )
  52.          )
  53.    )
  54. )
  55. ; ----------------------------------------------------------------
  56. (defun c:svline ()
  57.   (setq pp (list pp (getpoint "\nStarting Point:")))
  58.   (if (eq (cadr pp) nil) ; No input read?
  59.       (setq pp (list (car pp) (getvar "LASTPOINT"))) ; Use last point
  60.   )
  61.   (setq cp (list cp (getpoint (cadr pp) "\nTo Point:"))) ; Build Current point 
  62.   (while (not (eq (cadr cp) nil)) ; As long as points are entered.
  63.      (if (= (caadr pp) (caadr cp))
  64.         (prompt "No change in X") ; No change in X, do not draw side view.
  65.         (command "line" (list (caadr pp) (caar pp))   ; Draw side view
  66.                         (list (caadr pp) (cadar pp))  ; Otherwise.
  67.                         (list (caadr cp) (cadar cp))
  68.                         (list (caadr cp) (caar cp))
  69.                         "c"
  70.         )
  71.      )
  72.      (command "line" (cadr pp) (cadr cp) "") ; Line command for top view.
  73.      (setq pp cp) ; Set current point into previous point.
  74.      (setq cp (list (car cp) (getpoint (cadr pp) "\nTo Point:")))
  75.    )
  76.    (setq pp (car pp)) ; Set lists to Z vector data only.
  77.    (setq cp (car cp))
  78. )
  79. (prompt "\nFunctions loaded, use SVSTRT to establish initial")
  80. (prompt "\nvariable settings.  Use SVZSET to set side view z")
  81. (prompt "\nvalues.  Use SVLINE to draw on top view and side view!  ")
  82. ;
  83. ; ----------------------< Cut >------------------------------------
  84. ;
  85. ; =================================================================
  86. ;    SPSINP  Spread Sheet Interface Macro.     by Bill Kramer  1986
  87. ;    CADENCE Magazine  October 1986
  88. ;
  89. ;    Read a text file, character by character, building a set of
  90. ;    columns from the data.  Numeric data is expected to be found
  91. ;    in the comma delimitted format.
  92. ;
  93. ;    Variables Used
  94. ;
  95. ;       COLMS      List  (Real)      Location of decimal point in
  96. ;                                    column.
  97. ;       YY         Real              Current row location
  98. ;       FH         File Pointer      Input file handle
  99. ;       FNAM       String            File name
  100. ;       CH         Integer           Character read in from file
  101. ;       TH         Real              Text Heigh
  102. ;       TV         Real              Text Vertical Spacing Distance
  103. ;       FLAG       Integer           Header/Trailer flip-flop
  104. ;       NN         Integer           Current Column Number
  105. ;       NX         Integer           Max column number
  106. ;       HD         String            Header (before decimal)
  107. ;       TR         String            Trailer (after decimal)
  108. ; ====================================================================
  109. ;  Function SPSTXT, outputs text strings HD and TR.
  110. ;
  111. (defun spstxt ()
  112.    (setq flag 1) ; Reset Flip/Flop flag for definition of header/trailer.
  113.    (setq mmm (* th 0.25)) ; Space between decimal and header number.
  114.    (setq tx (- (nth nn colms) mmm)) 
  115.    (command   ; Right justify text to just left of decimal location.
  116.       "text" "r" (list tx yy) th 0.0
  117.       hd
  118.    )
  119.    (setq tx (+ tx mmm))
  120.    (command
  121.       "text" (list tx yy) th 0.0
  122.       (strcat "." tr)
  123.    )
  124.    (setq hd "") (setq tr "")(setq nn (1+ nn))
  125. )
  126. ; ---------------------------------------------
  127. ;  Function SPSINP (AutoCAD Macro)
  128. ; ---------------------------------------------
  129. (defun c:spsinp ()
  130.    (setvar "CMDECHO" 0)   ; Turn off command echos
  131.    (setq colms (list 0.0)) ; Initialize list of column settings.
  132.    (setq hd "") (setq tr "") ; Initialize character string variables.
  133.    (setq nx (getint "\nNumber of Columns:"))
  134.    (if (not (null nx))
  135.        (progn
  136.           (prompt "\nShow the Column X locations:")
  137.           (repeat nx
  138.             (setq colms (cons (car (getpoint)) colms))
  139.           )
  140.           (setq colms (cdr (reverse colms)))
  141.           (setq yy (cadr (getpoint "\nStarting Y Coordinate:")))
  142.           (setq th (getreal "\nText Height:"))
  143.           (setq tv (getreal "\nVertical Spacing:"))
  144.           (setq fnam (getstring "\nName of File:"))
  145.           (setq fh (open fnam "r"))
  146.           (setq ch 1)(setq nn 0)(setq flag 1)
  147.           (if (null fh) (prompt "\nFile not found"))
  148.           (while
  149.             (not (null fh)) 
  150.                (setq ch (read-char fh))
  151.                (cond
  152.                  ((= ch 44)   ; Comma ","
  153.                      (spstxt) ; End of column data, output text.
  154.                      (if (= nn nx)
  155.                           (progn
  156.                              (setq nn 0)
  157.                              (setq yy (- yy tv))
  158.                           )
  159.                      )
  160.                   )
  161.                   ((= ch 46) ; Period "."
  162.                      (setq flag 2) ; Remaining characters in trailer.
  163.                   )
  164.                   ((= ch 10) ; Return, end of line.
  165.                      (spstxt) ; End of column data, output text.
  166.                      (setq yy (- yy tv)) ; Prepare for next line.
  167.                      (setq nn 0)
  168.                   )
  169.                   ((= ch nil) ; End of file read?
  170.                      (close fh)
  171.                      (setq fh nil)
  172.                   )
  173.                   ((/= ch 32) ; Not a space, add to string.
  174.                      (if (= flag 1) ; Add to header or trailer?
  175.                          (setq hd (strcat hd (chr ch)))
  176.                          (setq tr (strcat tr (chr ch)))
  177.                      )
  178.                   )
  179.                ) ; End of Conditional Test of CH value.
  180.           ) ; End of While Loop
  181.        ) ; End of PROGN
  182.    ) ; End of IF test for column numbers****
  183. ;
  184. ; ----------------------< Cut >------------------------------------
  185. ;
  186. ; --------------------------------------------------------
  187. ;
  188. ;   Setpath & Animate               Bill Kramer
  189. ;   CADENCE Magazine   January 1987
  190. ;
  191. ;   Define a path (sequence of lines) for a block to
  192. ;   move along in "real time".
  193. ;
  194. (defun c:setpath ()
  195.    (prompt "Define a set of two or more points:")
  196.    (setq path-list nil)
  197.    (setq p1 (getpoint "\nStarting point:"))
  198.    (setq path-list (list p1))
  199.    (while (not (null (setq p1 (getpoint p1 "\nTo point:"))))
  200.           (setq path-list (cons p1 path-list)))
  201.    (setq path-list (reverse path-list))
  202.    (setq bname (car (entsel "\nSelect block to move:")))
  203.    (setq sdst (getdist "\nIncremental distance to move:")))
  204. (defun c:animate ()
  205.    (setq elist (entget bname))
  206.    (foreach pnt path-list
  207.         (setq elist (moveit elist pnt))))
  208. (defun moveit (elist topnt)
  209.    (setq dst (distance (cdr (assoc 10 elist)) topnt))
  210.    (setq ang (angle (cdr (assoc 10 elist)) topnt))
  211.    (setq dp (polar '(0 0) ang sdst))
  212.    (setq pdst 0.0)
  213.    (while (< (setq pdst (+ pdst sdst)) dst) 
  214.       (setq elist (entmod
  215.                      (subst
  216.                        (cons 10
  217.                          (mapcar '(lambda (a b) (+ a b))
  218.                                   (cdr (assoc 10 elist)) dp))
  219.                          (assoc 10 elist)
  220.                          elist))))
  221.     (entmod (subst (cons 10 topnt)
  222.                    (assoc 10 elist) elist)))
  223. ;
  224. ; ----------------------< Cut >------------------------------------
  225. ;
  226. ; ================================================================
  227. ;   Global Text Change Command            Bill Kramer
  228. ;
  229. ;   Edit text generation characteristics in graphics editor.
  230. ;
  231. ;   CADENCE Tutorial Application #8
  232. ;
  233. ;   Variables:
  234. ;     S1     Selection set
  235. ;     User   User entry string
  236. ;     Elist  Entity list (from selection set accessing)
  237. ;     New    New variable data from user
  238. ;
  239. ; ================================================================
  240. (defun c:GTCHANGE ()
  241.    (setq S1 nil) (gc)   ; Clear Selection set for use.
  242.    (prompt "\nSelect text objects:")
  243.    (setq S1 (ssget))
  244.    (ss-sieve S1 "TEXT") ; Utility routine from Listing 2.
  245.    (setq User "Go")
  246.    (while (/= User "Exit")
  247.       (setq User
  248.         (strcase
  249.          (getstring "\nChange: Style/Height/Oblq angle/Rot angle/ <eXit>:")))
  250.       (if (> (strlen User) 1) (setq User (substr User 1 1)))
  251.       (cond
  252.         ((and (/= User "X") (/= User ""))
  253.           (setq Code
  254.              (cond
  255.                ((= User "S") 7) 
  256.                ((= User "H") 40)           
  257.                ((= User "O") 51)
  258.                ((= User "R") 50) 
  259.                (t nil)))
  260.           (cond
  261.              ((boundp 'Code)
  262.                (setq New (getstring "\nNew value:"))
  263.                (if (> Code 20) (setq New (atof New)))
  264.                (if (and (> Code 49) (< Code 60))
  265.                     (setq New (* (/ New 180.0) pi)))
  266.                (setq CNT -1)
  267.                (repeat (sslength S1)
  268.                   (setq Elist (entget (ssname S1 (setq CNT (1+ CNT)))))
  269.                   (entmod
  270.                     (cond
  271.                        ((null (assoc Code Elist)) 
  272.                           (append Elist (list (cons Code New))))
  273.                        (t
  274.                           (subst (cons Code New) (assoc Code Elist) Elist)
  275.                        )
  276.                     )
  277.                   )
  278.                 )
  279.              )
  280.              (t (prompt "\nEntry invalid:")))
  281.         )
  282.         (t
  283.            (setq User "Exit"))))) 
  284. ; ===============================================================
  285. ;
  286. ;   Removes entities from selection set that are not equal to the
  287. ;   entity type name passed as parameter two.
  288. ;
  289. ;   (ss-sieve S1 Screen)    Programming Utility Routine
  290. ;
  291. ;   Variables:
  292. ;      S1       Selection set
  293. ;      Screen   String of entity type to keep {eg: TEXT, LINE,...}
  294. ;      CNT      Index into selection set
  295. ;      Elist    Current entity list
  296. ; ===============================================================
  297. (defun ss-sieve (S1 Screen)
  298.    (setq CNT (sslength S1))
  299.    (while (> CNT 0)
  300.       (setq Elist (entget (ssname S1 (setq CNT (1- CNT)))))
  301.       (cond
  302.         ((/= (cdr (assoc 0 Elist)) Screen)
  303.           (ssdel (ssname S1 CNT) S1)))))
  304. ╜ë'òY╛AROA     ARC ∞Ü&αR)ROBOT   ARC lá(vyτî