home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p055 / 2.ddi / SUPPORT.LIF / 028.BDRSURF.LSP < prev    next >
Encoding:
Text File  |  1989-02-21  |  2.3 KB  |  84 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. )