home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p086 / 3.img / ACADSUP.LIF / BDRSURF.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1991-08-26  |  3.4 KB  |  137 lines
  1.  
  2. ;    bdrsurf - create a bigd revolved surface
  3.  
  4. (defun c:bdrsurf ( / cecho blipmde regenmde attflags blkname s ename revang ss 
  5.         elist eaxis l n e etype point)
  6.     ; save current modes
  7.     (setq attflags (getvar "AFLAGS"))
  8.     (setvar "AFLAGS" 3)
  9.     (setq blipmde (getvar "BLIPMODE"))
  10.     (setvar "BLIPMODE" 0)
  11.     (setq cecho (getvar "CMDECHO"))
  12.     (setvar "CMDECHO" 0)
  13.     (setq regenmde (getvar "REGENMODE"))
  14.     (setvar "REGENMODE" 0)
  15.     (graphscr)
  16.  
  17.     ; get block name
  18.     (while (or (null blkname) (= blkname ""))
  19.         (setq blkname (getstring "\nBlock name: "))
  20.         (if (and (tblsearch "block" blkname)
  21.             (/= "Y" (strcase (substr (getstring (strcat "\nBlock "
  22.                 (strcase blkname) " already exists.\nRedefine it? <N> "))
  23.                 1 1))))
  24.             (setq blkname nil)
  25.         )
  26.     )
  27.  
  28.     ; get insertion point
  29.     (initget 17)
  30.     (setq insertpt (getpoint "\nInsertion base point: "))
  31.  
  32.     ; get included angle
  33.     (setq revang (getangle insertpt 
  34.         "\nIncluded angle (+=ccw,-=cw) <Full circle>: "))
  35.  
  36.     ; get selected entities to be revolved
  37.     (setq ss (ssget))
  38.     (if (boundp 'ss)
  39.         (progn
  40.             ; draw axis of revolution
  41.             (command "LINE" insertpt "@0,1" "")
  42.             (setq eaxis (list (entlast) insertpt))
  43.  
  44.             ; draw attribute definition for included angle
  45.             (if (null revang)
  46.                 (command "ATTDEF" "" "REVANG" "0.0" insertpt "" "")
  47.                 (command "ATTDEF" "" "REVANG" (rtos revang 2 16)
  48.                     insertpt "" ""))
  49.             (setq ss (ssadd (entlast) ss))
  50.  
  51.             ; draw each revolved entity
  52.             (setq l 0 n (sslength ss))
  53.             (while (< l n)
  54.                 (setq ename (ssname ss l))
  55.                 (setq e (entget ename))
  56.                 (setq etype (cdr (assoc 0 e)))
  57.                 (setq point (cdr (assoc 10 e)))
  58.                 (setq elist (list ename point))
  59.                 (if (or (= etype "LINE") (= etype "ARC") (= etype "CIRCLE"))
  60.                     (progn
  61.                         (if (null revang)
  62.                             (command "REVSURF" elist eaxis "" "")
  63.                             (command "REVSURF" elist eaxis "" (angtos revang)))
  64.                         (setq ss (ssadd (entlast) ss))
  65.                     )
  66.                 )
  67.                 (setq l (1+ l))
  68.             )
  69.  
  70.             ; create block
  71.             (if (tblsearch "block" blkname)
  72.                 (command "BLOCK" blkname "Y" insertpt ss "")
  73.                 (command "BLOCK" blkname insertpt ss ""))
  74.  
  75.             ; erase axis of revolution
  76.             (command "ERASE" (cadr eaxis) "")
  77.         )
  78.     )
  79.     (setvar "AFLAGS" attflags)
  80.     (setvar "BLIPMODE" blipmde)
  81.     (setvar "CMDECHO" cecho)
  82.     (setvar "REGENMODE" regenmde)
  83.     (princ)
  84. )
  85.  
  86.  
  87. ;    edrsurf - edit a bigd revolved surface
  88.  
  89. (defun c:edrsurf ( / cecho blkname blk insertpt e elast)
  90.     (setq cecho (getvar "CMDECHO"))
  91.     (setvar "CMDECHO" 0)
  92.  
  93.     ; get block name
  94.     (setq blkname nil)
  95.     (while (or (null blkname) (= blkname ""))
  96.         (setq blkname (getstring "\nBIG D block to edit: "))
  97.         (if (null (setq blk (tblsearch "block" blkname)))
  98.             (progn
  99.                 (prompt (strcat "\n*** Error: Block " blkname
  100.                     " does not exist ***"))
  101.                 (setq blkname nil)
  102.             )
  103.         )
  104.     )
  105.  
  106.     ; get insertion point
  107.     (initget 1)
  108.     (setq insertpt (getpoint "Insertion point: "))
  109.  
  110.     ; save the last main entity
  111.     (setq elast (entlast))
  112.  
  113.     ; insert the block as separate parts
  114.     (command "INSERT" (strcat "*" blkname) insertpt "" "")
  115.  
  116.     ; if no entities previously existed, start with first entity
  117.     (if (null elast)
  118.         (setq elast (entnext))
  119.         (setq elast (entnext elast)))
  120.  
  121.     ; delete all new non-valid entities
  122.     (while (setq e elast)
  123.         (setq etype (cdr (assoc 0 (entget e))))
  124.         (if (or (= etype "POLYLINE") (= etype "ATTDEF"))
  125.             (entdel e)
  126.             (setq elast (entnext elast))
  127.         )
  128.     )
  129.  
  130.     ; redraw the screen
  131.     (command "REDRAW")
  132.  
  133.     (setvar "CMDECHO" cecho)
  134.     (princ)
  135. )
  136.  
  137.