home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p047 / 4.ddi / 3D / R-SURF.LSP < prev    next >
Encoding:
Text File  |  1987-03-31  |  10.3 KB  |  388 lines
  1. ;********************* C:R-SURF.LSP ******************************************
  2. ;****************************************************************************
  3. ;
  4. ;  Function to create a "rotated surface" from a profile, center line,
  5. ;   and center point.
  6. ;  The "surface" is created from the 3dface entity, and is currently
  7. ;   rotated only about a z-axis.  The general case (about any axis)
  8. ;   is left as an exercise.
  9. ;
  10. ;
  11. ; by Simon Jones - Autodesk UK Ltd.
  12. ;   embellished by John Lynch - Autodesk, Inc.
  13. ;
  14. ;
  15. ;  This file contains a number of functions, which are called from the main
  16. ;   and other functions.  The use of the functions are documented in the
  17. ;   accompanying comments.
  18. ;
  19. ;  GLOBAL VARIABLES:
  20. ;
  21. ;   cen:    center point of surface generation in the x-y plane
  22. ;   lat:    Lateral constant for control of segmentation of arc segments
  23. ;   segno:    Radial segmentation constant
  24. ;   div:    Number of divisions to fill the desired sweep angle
  25. ;   array-deg:    Number of degrees for the circular array
  26. ;   v1list:    Vertex no. 1 entity list
  27. ;   v2list:    Vertex no. 2 entity list
  28. ;   p:        profile polyline entity name
  29. ;   cenx:    Center point for the array
  30. ;   cx:     x-coordinate of the start point of the center line
  31. ;   cy:     y-coordinate of the start point of the center line
  32. ;   minrad:    dist from the center line to the last point on the profile
  33. ;   maxrad:    dist from the center line to the current point on the profile
  34. ;   elev:    current incremental elevation
  35. ;   h:        vertical increment from last to current point on profile
  36. ;   cflag:    closed polyline flag
  37. ;
  38. ;
  39. ;********************** DRAW SINGLE SEGMENT *******
  40. ;
  41. ; Construct a single 3DFACE segment
  42. ;
  43. (defun dseg ( / pt1 pt2 pt3 pt4)
  44.      (setq pt1 (polar cen 0 minrad))
  45.      (setq pt2 (polar cen 0 maxrad))
  46.      (setq pt3 (polar cen div maxrad))
  47.      (setq pt4 (polar cen div minrad))
  48.      (command "3DFACE"
  49.           (list (car pt1) (cadr pt1) (+ elev h))
  50.           (list (car pt2) (cadr pt2) elev )
  51.           (list (car pt3) (cadr pt3) elev )
  52.           (list (car pt4) (cadr pt4) (+ elev h))
  53.      )
  54.      (command "")
  55. )
  56.  
  57. ;************************ LINSEG() *******************
  58. ;  Function to handle a linear segment of a polyline
  59.  
  60. (defun linseg()
  61.     (setq maxrad (- (car cenx) (cadr (assoc 10 v1list))))
  62.     (setq minrad (- (car cenx) (cadr (assoc 10 v2list))))
  63.     (setq h (- (caddr (assoc 10 v2list))
  64.            (caddr (assoc 10 v1list))
  65.         )
  66.     )
  67.     (dseg)
  68.     (command "ARRAY" (entlast) "" "P" cen segno array-deg "")
  69.     (setq elev (+ elev h))         ; reset the elevation for next seg
  70. )
  71.  
  72.  
  73. ;************************** ARCSEG() ***********************
  74. ;  Function to handle a polyline arc segment.
  75. ;
  76. (defun arcseg (s e b / iang mpt dang cpt rad mpt nseg bpt ept dd )
  77. ;
  78. ; s  : Starting point
  79. ; e  : Ending point
  80. ; b  : Bulge of arc
  81. ;
  82. ;
  83. ; Calculate the included angle, midpoint between vertices,
  84. ; and the directional angle from the starting to ending vertex
  85. ;
  86.   (setq iang (* 4 (atan (abs b)))
  87.     mpt  (midpt s e)
  88.     dang (angle s e)
  89.   )
  90.   ;find the center and radius of the arc
  91.   (if (< (abs b) 1)     ; if the bulge is > 1
  92.     (progn         ;  use the complementary arc
  93.       (setq rad (/ (/ (distance s e) 2) (sin (/ iang 2)))
  94.         m (* rad (cos (/ iang 2)))
  95.       )
  96.       (if (< b 0)          ; clockwise or counterclockwise?
  97.     (setq cpt (polar mpt (- dang (/ pi 2)) m))
  98.     (setq cpt (polar mpt (+ dang (/ pi 2)) m))
  99.       )
  100.     )      ; end of progn
  101.     (progn         ; otherwise ...
  102.       (setq rad (/ (/ (distance s e) 2) (sin (- pi (/ iang 2))))
  103.         m (* rad (cos (- pi (/ iang 2))))
  104.       )
  105.       (if (< b 0)
  106.     (setq cpt (polar mpt (+ dang (/ pi 2)) m))
  107.     (setq cpt (polar mpt (- dang (/ pi 2)) m))
  108.       )
  109.     )       ; end of progn
  110.   )       ; end of if
  111.  
  112.  
  113.   (if (< b 0) (setq iang (- 0.0 iang))) ; negative bulge means clockwise
  114.                     ;    arc
  115. ;
  116. ; Set the number of segments according to the value of "lat" (global)
  117. ;
  118.   (setq nseg lat
  119.      dd (/ iang (+ nseg 1))       ; delta angle based on nseg
  120.      bpt s               ; initialized beginning point to
  121.                    ;    start of arc
  122.      cnt 0               ; initialize count to 0
  123.    )
  124. ;
  125.   (while (< cnt nseg)
  126.     (setq ept (polar cpt (+ (angle cpt bpt) dd) rad)   ; endpoint for this
  127.                                ;    segment
  128.       maxrad (- (car cenx) (car bpt))
  129.       minrad (- (car cenx) (car ept))
  130.       h (- (cadr ept) (cadr bpt))
  131.     )
  132.     (dseg)
  133.     (command "ARRAY" (entlast) "" "P" cen segno array-deg "")
  134. ;
  135. ;  Reset the starting point and increment cnt and elev
  136. ;
  137.     (setq bpt ept
  138.       cnt (1+ cnt)
  139.       elev (+ elev h)
  140.     )
  141.   )
  142. ;
  143. ;---- Do the last segment, which ends on the endpoint of the arc
  144. ;
  145.   (setq ept e
  146.     maxrad (- (car cenx) (car bpt))
  147.     minrad (- (car cenx) (car ept))
  148.     h (- (cadr ept) (cadr bpt))
  149.   )
  150.   (dseg)
  151.   (command "ARRAY" (entlast) "" "P" cen segno array-deg "")
  152. ;
  153. ;  Reset elev
  154. ;
  155.   (setq elev (+ elev h))
  156.  
  157. ;
  158. )
  159.  
  160.  
  161. ;
  162. ;---- Function to calculate and return the midpoint between two points.
  163. ;
  164. (defun midpt(p1 p2)
  165.   (setq x1 (car p1)
  166.     y1 (cadr p1)
  167.     x2 (car p2)
  168.     y2 (cadr p2)
  169.   )
  170.   (list (/ (+ x1 x2) 2) (/ (+ y1 y2) 2))
  171. )
  172.  
  173. ;***************** Degree and Radian Conversions **************
  174. ;
  175. ; Convert Degrees to Radians
  176. ;
  177. (defun dtr (a)
  178.   (* pi (/ a 180.0))
  179. )
  180.  
  181. ; Convert Radians to Degrees
  182. ;
  183. (defun rtd (a)
  184.   (/ (* a 180.0) pi)
  185. )
  186.  
  187. ;***************** Store and Restore current "MODES" **********
  188. ;
  189. ; Saves the SETVARs specified in the mode list into the global MLST.
  190. ; The specified modes must not be read only.  i.e. "CLAYER" should
  191. ; not be included in the list.
  192. ;
  193. (defun MODES (a)
  194.    (setq MLST '())
  195.    (repeat (length a)
  196.       (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
  197.       (setq a (cdr a)))
  198. )
  199. ;
  200. ; Restores the SETVARs specified in the global MLST.
  201. ;
  202. (defun MODER ()
  203.    (repeat (length MLST)
  204.       (setvar (caar MLST) (cadar MLST))
  205.       (setq MLST (cdr MLST))
  206.    )
  207. )
  208.  
  209. ;******************* ERROR FUNCTION *************
  210. ;
  211. ;  Resets variables and Errors out.
  212. ;
  213. (defun *ERROR* (st)
  214.   (moder)
  215.   (terpri)
  216.   (princ "\nerror: ")
  217.   (prompt (strcat st "\n"))
  218. )
  219.  
  220. ;*********************** C-LINE ****************
  221. ; Function to select the center line of profile
  222.  
  223. (defun c-line ( / cline clist loop)
  224.     (setq loop t)
  225.     (while loop
  226.       (setq cline (entsel "\nSelect centre line: "))
  227.       (if (= (car cline) nil)
  228.       (progn
  229.          (prompt " 1 selected, 0 found.")
  230.          (setq loop t)
  231.          (setq clist '( '(0 . "JUNK")))    ; dummy assoc list for following
  232.                          ;    test of entity
  233.       )
  234.       (setq clist (entget (car cline)))
  235.       )
  236.       (if (/= (cdr (assoc 0 clist)) "LINE")
  237.       (progn
  238.          (prompt " Entity selected is not a line.")
  239.          (setq loop t)
  240.       )
  241.       (setq loop nil)              ; all tests pass - exit loop
  242.       )
  243.     )
  244.     (setq cx (cadr (assoc 10 clist))         ; global variables for x & y coord
  245.       cy (caddr (assoc 10 clist))         ;    of start point of center line
  246.     )
  247. )
  248.  
  249. ;************************ PROSEL() ***********************************
  250. ; Function to select the profile for the surface
  251.  
  252. (defun prosel ( / plist loop)
  253.     (setq cflag nil)
  254.     (setq loop t)
  255.     (while loop
  256.       (setq p (entsel "\nSelect Profile: "))   ; global variable for use in
  257.                            ;   main program
  258.       (if (= (car p) nil)
  259.       (progn
  260.          (prompt " 1 selected, 0 found.")
  261.          (setq loop t)
  262.          (setq plist '( '(0 . "JUNK")))    ; dummy assoc list for following
  263.                          ;    test of entity
  264.       )
  265.       (setq plist (entget (car p)))
  266.       )
  267.       (if (/= (cdr (assoc 0 plist)) "POLYLINE")
  268.       (progn
  269.          (prompt " Entity selected is not a polyline.")
  270.          (setq loop t)
  271.       )
  272.       (setq loop nil)              ; all tests pass - exit loop
  273.       )
  274.     )
  275.     (if (or (= (cdr (assoc 70 plist)) 1)
  276.         (= (cdr (assoc 70 plist)) 3)
  277.     )
  278.     (setq cflag 1)
  279.     )
  280. )
  281.  
  282. ;*********************** MAIN PROGRAM ***************************
  283.  
  284. (defun C:R-SURF ( / deg v1 v2 c1 c1list bulge)
  285.  
  286.    ; Store the system variables which are changed during the function
  287.    (modes '("ELEVATION" "THICKNESS" "CMDECHO" "BLIPMODE" "HIGHLIGHT"))
  288.  
  289.    ; Set the appropriate values of the system variables
  290.    (setvar "CMDECHO" 0)
  291.    (setvar "HIGHLIGHT" 0)
  292.  
  293.    ; Select the profile for the rotated surface
  294.    (prosel)
  295.  
  296.    ; Select the centre line of the profile
  297.    (c-line)
  298.  
  299.  
  300.    ; Select the centre point for the construction of the surface--------- CEN
  301.  
  302.    (setq cen (getpoint "\nCentre point for construction: "))
  303.  
  304.    ; Enter the sweep angle of the surface  ------------------------- DEG
  305.  
  306.    (setq deg (getangle cen "\nDegrees of rotation <360>: "))
  307.    (if (= deg nil)
  308.        (setq deg 360)
  309.        (setq deg (rtd deg))
  310.    )
  311.  
  312.    ; Enter the constant to control arc segmentation -------- LAT
  313.  
  314.    (setq lat (getint "\nArc segment constant <10>: "))
  315.    (if (= lat nil)
  316.        (setq lat 10)
  317.    )
  318.  
  319.    ; Enter value to control radial segmentation  ------------------ SEGNO
  320.  
  321.    (setq segno (getint "\nRadial segment constant <15>: "))
  322.    (if (= segno nil)
  323.        (setq segno 15)
  324.    )
  325.  
  326.    ; Set up the number of divisions from the sweep angle
  327.  
  328.    (setq div (/ deg segno))
  329.    (setq array-deg (- deg div))
  330.    (setq div (dtr div))
  331.  
  332.    (setvar "BLIPMODE" 0)
  333.  
  334.    ; Set the vertices and retrieve vertex data
  335.  
  336.    (setq v1 (entnext (car p)))
  337.    (setq v1list (entget v1))
  338.    (setq v2 (entnext v1))
  339.    (setq v2list (entget v2))
  340.  
  341.  
  342.    ; Set the closing vertex equal to the starting vertex  -------- C1
  343.  
  344.    (setq c1 v1)
  345.    (setq c1list v1list)
  346.  
  347.    ; Set the center point for the array from the center line value
  348.    (setq cenx (list cx (caddr (assoc 10 v1list))))
  349.  
  350.    ; Set the starting elevation to the current elevation plus the
  351.    ;  y coordinate of the first vertex relative to the start of the center line
  352.  
  353.    (setq elev (+ (getvar "ELEVATION")
  354.          (- (caddr (assoc 10 v1list)) cy)
  355.           )
  356.    )
  357.  
  358.    ; Process the vertices of the polyline ...
  359.  
  360.  
  361.    (while (= (cdr (assoc 0 v2list)) "VERTEX")
  362.       (setq bulge (cdr (assoc 42 v1list)))
  363.       (if (= bulge 0)
  364.      (linseg)
  365.      (arcseg (cdr (assoc 10 v1list)) (cdr (assoc 10 v2list)) bulge)
  366.       )
  367.       ; Reset the vertex lists for the next segment
  368.       (setq v1 v2
  369.         v1list v2list
  370.         v2 (entnext v1)
  371.         v2list (entget v2)
  372.       )
  373.    )
  374.  
  375.    ; Test for a closed polyline
  376.    (if (or (= cflag 1) (= cflag 3))
  377.        (progn
  378.     (setq v2 c1)
  379.     (setq v2list c1list)
  380.     (linseg)           ; Draw the closing linear segment
  381.        )
  382.    )
  383.  
  384.    ; Reset the system variables
  385.    (moder)
  386. )
  387.  
  388.