;********************* C:R-SURF.LSP ******************************************
;****************************************************************************
;
; Function to create a "rotated surface" from a profile, center line,
; and center point.
; The "surface" is created from the 3dface entity, and is currently
; rotated only about a z-axis. The general case (about any axis)
; is left as an exercise.
;
;
; by Simon Jones - Autodesk UK Ltd.
; embellished by John Lynch - Autodesk, Inc.
;
;
; This file contains a number of functions, which are called from the main
; and other functions. The use of the functions are documented in the
; accompanying comments.
;
; GLOBAL VARIABLES:
;
; cen: center point of surface generation in the x-y plane
; lat: Lateral constant for control of segmentation of arc segments
; segno: Radial segmentation constant
; div: Number of divisions to fill the desired sweep angle
; array-deg: Number of degrees for the circular array
; v1list: Vertex no. 1 entity list
; v2list: Vertex no. 2 entity list
; p: profile polyline entity name
; cenx: Center point for the array
; cx: x-coordinate of the start point of the center line
; cy: y-coordinate of the start point of the center line
; minrad: dist from the center line to the last point on the profile
; maxrad: dist from the center line to the current point on the profile
; elev: current incremental elevation
; h: vertical increment from last to current point on profile
; cflag: closed polyline flag
;
;
;********************** DRAW SINGLE SEGMENT *******
;
; Construct a single 3DFACE segment
;
(defun dseg ( / pt1 pt2 pt3 pt4)
(setq pt1 (polar cen 0 minrad))
(setq pt2 (polar cen 0 maxrad))
(setq pt3 (polar cen div maxrad))
(setq pt4 (polar cen div minrad))
(command "3DFACE"
(list (car pt1) (cadr pt1) (+ elev h))
(list (car pt2) (cadr pt2) elev )
(list (car pt3) (cadr pt3) elev )
(list (car pt4) (cadr pt4) (+ elev h))
)
(command "")
)

;************************ LINSEG() *******************
; Function to handle a linear segment of a polyline

(defun linseg()
(setq maxrad (- (car cenx) (cadr (assoc 10 v1list))))
(setq minrad (- (car cenx) (cadr (assoc 10 v2list))))
(setq h (- (caddr (assoc 10 v2list))
(caddr (assoc 10 v1list))
)
)
(dseg)
(command "ARRAY" (entlast) "" "P" cen segno array-deg "")
(setq elev (+ elev h)) ; reset the elevation for next seg
)

;************************** ARCSEG() ***********************
; Function to handle a polyline arc segment.
;
(defun arcseg (s e b / iang mpt dang cpt rad mpt nseg bpt ept dd )
;
; s : Starting point
; e : Ending point
; b : Bulge of arc
;
;
; Calculate the included angle, midpoint between vertices,
; and the directional angle from the starting to ending vertex
;
(setq iang (* 4 (atan (abs b)))
mpt (midpt s e)
dang (angle s e)
)
;find the center and radius of the arc
(if ( 1
(progn ; use the complementary arc
(setq rad (/ (/ (distance s e) 2) (sin (/ iang 2)))
m (* rad (cos (/ iang 2)))
)
(if (< b 0) ; clockwise or counterclockwise?
(setq cpt (polar mpt (- dang (/ pi 2)) m))
(setq cpt (polar mpt (+ dang (/ pi 2)) m))
)
) ; end of progn
(progn ; otherwise ...
(setq rad (/ (/ (distance s e) 2) (sin (- pi (/ iang 2))))
m (* rad (cos (- pi (/ iang 2))))
)
(if (< b 0)
(setq cpt (polar mpt (+ dang (/ pi 2)) m))
(setq cpt (polar mpt (- dang (/ pi 2)) m))
)
) ; end of progn
) ; end of if

(if (< b 0) (setq iang (- 0.0 iang))) ; negative bulge means clockwise
; arc
;
; Set the number of segments according to the value of "lat" (global)
;
(setq nseg lat
dd (/ iang (+ nseg 1)) ; delta angle based on nseg
bpt s ; initialized beginning point to
; start of arc
cnt 0 ; initialize count to 0
)
;
(while (< cnt nseg)
(setq ept (polar cpt (+ (angle cpt bpt) dd) rad) ; endpoint for this
; segment
maxrad (- (car cenx) (car bpt))
minrad (- (car cenx) (car ept))
h (- (cadr ept) (cadr bpt))
)
(dseg)
(command "ARRAY" (entlast) "" "P" cen segno array-deg "")
;
; Reset the starting point and increment cnt and elev
;
(setq bpt ept
cnt (1+ cnt)
elev (+ elev h)
)
)
;
;---- Do the last segment, which ends on the endpoint of the arc
;
(setq ept e
maxrad (- (car cenx) (car bpt))
minrad (- (car cenx) (car ept))
h (- (cadr ept) (cadr bpt))
)
(dseg)
(command "ARRAY" (entlast) "" "P" cen segno array-deg "")
;
; Reset elev
;
(setq elev (+ elev h))

;
)

;
;---- Function to calculate and return the midpoint between two points.
;
(defun midpt(p1 p2)
(setq x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
)
(list (/ (+ x1 x2) 2) (/ (+ y1 y2) 2))
)

;***************** Degree and Radian Conversions **************
;
; Convert Degrees to Radians
;
(defun dtr (a)
(* pi (/ a 180.0))
)

; Convert Radians to Degrees
;
(defun rtd (a)
(/ (* a 180.0) pi)
)

;***************** Store and Restore current "MODES" **********
;
; Saves the SETVARs specified in the mode list into the global MLST.
; The specified modes must not be read only. i.e. "CLAYER" should
; not be included in the list.
;
(defun MODES (a)
(setq MLST '())
(repeat (length a)
(setq MLST (append MLST (list (list (car a) (getvar (car a))))))
(setq a (cdr a)))
)
;
; Restores the SETVARs specified in the global MLST.
;
(defun MODER ()
(repeat (length MLST)
(setvar (caar MLST) (cadar MLST))
(setq MLST (cdr MLST))
)
)

;******************* ERROR FUNCTION *************
;
; Resets variables and Errors out.
;
(defun *ERROR* (st)
(moder)
(terpri)
(princ "\nerror: ")
(prompt (strcat st "\n"))
)

;*********************** C-LINE ****************
; Function to select the center line of profile

(defun c-line ( / cline clist loop)
(setq loop t)
(while loop
(setq cline (entsel "\nSelect centre line: "))
(if (= (car cline) nil)
(progn
(prompt " 1 selected, 0 found.")
(setq loop t)
(setq clist '( '(0 . "JUNK"))) ; dummy assoc list for following
; test of entity
)
(setq clist (entget (car cline)))
)
(if (/= (cdr (assoc 0 clist)) "LINE")
(progn
(prompt " Entity selected is not a line.")
(setq loop t)
)
(setq loop nil) ; all tests pass - exit loop
)
)
(setq cx (cadr (assoc 10 clist)) ; global variables for x & y coord
cy (caddr (assoc 10 clist)) ; of start point of center line
)
)

;************************ PROSEL() ***********************************
; Function to select the profile for the surface

(defun prosel ( / plist loop)
(setq cflag nil)
(setq loop t)
(while loop
(setq p (entsel "\nSelect Profile: ")) ; global variable for use in
; main program
(if (= (car p) nil)
(progn
(prompt " 1 selected, 0 found.")
(setq loop t)
(setq plist '( '(0 . "JUNK"))) ; dummy assoc list for following
; test of entity
)
(setq plist (entget (car p)))
)
(if (/= (cdr (assoc 0 plist)) "POLYLINE")
(progn
(prompt " Entity selected is not a polyline.")
(setq loop t)
)
(setq loop nil) ; all tests pass - exit loop
)
)
(if (or (= (cdr (assoc 70 plist)) 1)
(= (cdr (assoc 70 plist)) 3)
)
(setq cflag 1)
)
)

;*********************** MAIN PROGRAM ***************************

(defun C:R-SURF ( / deg v1 v2 c1 c1list bulge)

; Store the system variables which are changed during the function
(modes '("ELEVATION" "THICKNESS" "CMDECHO" "BLIPMODE" "HIGHLIGHT"))

; Set the appropriate values of the system variables
(setvar "CMDECHO" 0)
(setvar "HIGHLIGHT" 0)

; Select the profile for the rotated surface
(prosel)

; Select the centre line of the profile
(c-line)

; Select the centre point for the construction of the surface--------- CEN

(setq cen (getpoint "\nCentre point for construction: "))

; Enter the sweep angle of the surface ------------------------- DEG

(setq deg (getangle cen "\nDegrees of rotation : "))
(if (= deg nil)
(setq deg 360)
(setq deg (rtd deg))
)

; Enter the constant to control arc segmentation -------- LAT

(setq lat (getint "\nArc segment constant : "))
(if (= lat nil)
(setq lat 10)
)

; Enter value to control radial segmentation ------------------ SEGNO

(setq segno (getint "\nRadial segment constant : "))
(if (= segno nil)
(setq segno 15)
)

; Set up the number of divisions from the sweep angle

(setq div (/ deg segno))
(setq array-deg (- deg div))
(setq div (dtr div))

(setvar "BLIPMODE" 0)

; Set the vertices and retrieve vertex data

(setq v1 (entnext (car p)))
(setq v1list (entget v1))
(setq v2 (entnext v1))
(setq v2list (entget v2))

; Set the closing vertex equal to the starting vertex -------- C1

(setq c1 v1)
(setq c1list v1list)

; Set the center point for the array from the center line value
(setq cenx (list cx (caddr (assoc 10 v1list))))

; Set the starting elevation to the current elevation plus the
; y coordinate of the first vertex relative to the start of the center line

(setq elev (+ (getvar "ELEVATION")
(- (caddr (assoc 10 v1list)) cy)
)
)

; Process the vertices of the polyline ...

(while (= (cdr (assoc 0 v2list)) "VERTEX")
(setq bulge (cdr (assoc 42 v1list)))
(if (= bulge 0)
(linseg)
(arcseg (cdr (assoc 10 v1list)) (cdr (assoc 10 v2list)) bulge)
)
; Reset the vertex lists for the next segment
(setq v1 v2
v1list v2list
v2 (entnext v1)
v2list (entget v2)
)
)

; Test for a closed polyline
(if (or (= cflag 1) (= cflag 3))
(progn
(setq v2 c1)
(setq v2list c1list)
(linseg) ; Draw the closing linear segment
)
)

; Reset the system variables
(moder)
)

Advertisements