`;********************* 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

```
```