Help Needed lisp Routine for Creating 3D Polylines with Specified Slope"
Attached is a more reliable version of the program. I added the option of letting the user specify whether they want a left or right bias when finding the path of constant slope. In the image below the red line is a path of 20% grade with a left bias and the green a right bias. The magenta and yellow lines are 10% grades.
(defun c:SpecSlope (/ designSlope p pStart ss faceName faceData A B C Normal slopeVector slopeFace
err gamma q qList pLL pUR face1 face2 x)
; Creates a path along a collection of 3d faces of user defined slope.
; The path is defined by individual line segments.
; User input:
; Design slope, default = 0.2 (20%)
; Point on edge of a 3dface
; Selection of the 3dface with the point
; Fixes in v.02
; 1. Fixed bug that restricted slope to 0.2
; 2. A 3dpoly is created.
; Fixes in v.05
; 1. Face selection error solved by add zoom to q after each iteration.
; 2. Zooms to stating point at end of execution.
; Issues
; 1. Does not handle case of path leading to the vertex of several 3dfaces.
; 2. User control of which of 2 valid directions to take is not provided.
; L. Minardi 9/7/2024 v5
(setq k 1) ; used for debugging
(setq designSlope (getreal "\nEnter slope, (e.g. .2 = 20%): "))
(if (not designslope)
(setq designslope 0.2)
)
(initget "Left Right")
(if (null
(setq bias (getkword
"\nChoose path direction bias [Left/Right] <Left>: "
)
)
)
(setq bias "Left")
)
(setq p (getpoint "\nEnter start point on the edge of a face. ")
pStart p
)
(command "point" "_non" p)
(princ "\n Select the 3dface of the stating point: ")
(setq ss (ssget '((0 . "3DFACE"))) ; get data for 3Dface
faceName (ssname ss 0)
Qlist (list p)
)
(setvar "cmdecho" 0)
(while faceName
(setq faceData (get_face_data faceName designSlope)
A (nth 0 faceData)
B (nth 1 faceData)
C (nth 2 faceData)
Normal (nth 3 faceData)
slopeVector (nth 4 faceData)
slopeFace (nth 5 faceData)
err (nth 6 faceData)
)
(if (= err 1)
(progn (princ "\nNoSolution, 3dFace slope is less than maximum slope.\nSlope = " )
(princ slopeface)
(setq faceName nil)
)
(progn
(setq gamma (- (acos (/ designSlope slopeFace))))
(if (equal (strcase bias) "RIGHT")
(setq gamma (* -1. gamma))
)
;;;(princ "\ngamma = ")
;;;(princ gamma)
;;;(princ "\nk = ") (princ k) (setq k (+ k 1))
(setq q (FindQ p A B C slopeVector designSlope gamma))
(if q ; [1]
(progn
(setq qList (append qList (list q)))
(command "_zoom" "c" q 5)
(setq ss (ssget "_c" q q '((0 . "3dface"))))
(setq sslen (sslength ss))
(cond
((= ss nil)
(progn
(princ "\nERROR! No selection at Q.")
(command "_circle" "_non" q 0.2); draw circle to show error location
(setq facename nil) ; to terminate while
)
)
((/= sslen 2)
(progn
(princ "\Other than two 3dfaces selected at Q.")
(command "_circle" "_non" q 0.2)
; draw circle to show error location
(setq facename nil) ; to terminate while
)
)
(progn
(setq face1 (ssname ss 0)
face2 (ssname ss 1)
)
(if (equal face1 facename)
(setq faceName face2)
(setq faceName face1)
)
(setq p q)
)
) ; end cond
) ; end progn no errors
) ; end if [1]
) ;end progn
) ; end if
) ; end while
(command "_3dpoly" ) ;start 3dpoly command
(while (= (getvar "cmdactive") 1) ;while a command is running loop (it is because we haven't entered any points)
(repeat (setq x (length qList))
(command "_non" (nth (setq x (- x 1)) qList))
) ;end repeat
(command "") ;end 3dpoly
)
(command "_zoom" "c" pStart 5)
(setvar "cmdecho" 1)
(princ "\nDONE!")
(princ)
)
(defun FindQ ( p v1 v2 v3 slopeVector designSlope gamma / q s q1 q2 q3 )
; determine up hill point at slope = designSlope
; p = start point
; v1, v2, v3 = 3dface vertices
; slopeVector = slope vector of 3dface that points in the uphill direction
; designSlope = desired slope of line (e.g., 0.2 = 20%)
; gamma = angle between the projection of slopeVector to xy plane and the
; direction of the designSlope line projected to the XY plane
(setq Q
(mapcar
'+
p
(list
(-
(* (car slopevector) (cos gamma))
(* (cadr slopevector) (sin gamma))
)
(+
(* (car slopevector) (sin gamma))
(* (cadr slopevector) (cos gamma))
)
(* designSlope
(sqrt
(+ (expt (car slopevector) 2) (expt (cadr slopevector) 2))
)
)
)
)
)
; define vector from p towards q
(setq s (mapcar '+ p (mapcar '* (mapcar '- q p) '(1000 1000 1000))))
(if s
(progn
; get the three intersections of design slope vector with face edges
(setq q1 (inters v1 v2 p s nil)
q2 (inters v2 v3 p s nil)
q3 (inters v3 v1 p s nil)
)
; check if q1, q2, q3, are on an edge segment of face
; set qn to nil if not on line segment
(if (not (equal (distance v1 v2)
(+ (distance v1 q1) (distance q1 v2))
1e-5
)
) ; q1 is on line segment?
(setq q1 nil) ; q1 is not on line segment
)
(if (not (equal (distance v2 v3)
(+ (distance v2 q2) (distance q2 v3))
1e-5
)
) ; q2 on line segment?
(setq q2 nil)
)
(if (not (equal (distance v3 v1)
(+ (distance v3 q3) (distance q3 v1))
1e-5
)
) ; q3 on line segment?
(setq q3 nil)
)
;set q to nil if q coincident with p
(if (equal q1 p 0.001)
(setq q1 nil)
)
(if (equal q2 p 0.001)
(setq q2 nil)
)
(if (equal q3 p 0.001)
(setq q3 nil)
)
; set q to only non-nil qn
(cond
(q1 (setq q q1))
(q2 (setq q q2))
(q3 (setq q q3))
)
) ; end s true
; ?????????????? test needed if Q lower than P???????
(progn ; s = nil
(princ "\nIntersection not found.\n")
(command "_circle" "_non" p 0.2)
(setq q nil)
)
) ; end if s
)
;;;;;;;;;;;;;;;;;;;
(defun get_face_data (faceName designSlope / A B C Normal slopeVector slopeFace designSlope faceData err)
; Given a face name determine its vertices, normal vector, slope vector, slope, and error if any.
; Returns a list with the data
; err = nil, no errors
; err = 1, no solution, the slope of the face is less than the design slope
(setq faceData (entget faceName))
(setq A (cdr (assoc 10 faceData)) ;three corners of the 3DFACE
B (cdr (assoc 11 faceData))
C (cdr (assoc 12 faceData))
Normal (cross (mapcar '- B A) (mapcar '- C B))
err nil
)
(setq slopeVector (cross Normal (cross Normal '(0 0 1))))
(if (< (caddr slopeVector) 0.) ; make sure normal has a + z coorindate
(setq slopeVector (mapcar '* '(-1 -1 -1) slopeVector))
)
(setq slopeFace
(/
(caddr slopeVector)
(distance '(0 0 0)
(list (car slopeVector) (cadr slopeVector) 0.0)
)
)
)
(if (< slopeface designSlope)
(setq err 1)
)
(setq facedata (list A B C Normal slopeVector slopeFace err))
)
; Unit vector of v
(defun unitvec (v / x)
(setq x (distance '(0 0 0) v)
x (mapcar '/ v (list x x x))
)
)
;; ArcCosine - Lee Mac
;; Args: -1 <= x <= 1
(defun acos ( x )
(if (<= -1.0 x 1.0)
(atan (sqrt (- 1.0 (* x x))) x)
)
)
; dot product of vectors a and b
(defun dot (a b / dd)
(setq dd (mapcar '* a b))
(setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
);end of dot
;;; cross product of vectors a and b
(defun cross (a b / crs)
(setq crs (list
(- (* (nth 1 a) (nth 2 b))
(* (nth 1 b) (nth 2 a))
)
(- (* (nth 0 b) (nth 2 a))
(* (nth 0 a) (nth 2 b))
)
(- (* (nth 0 a) (nth 1 b))
(* (nth 0 b) (nth 1 a))
)
) ;end list
) ;end setq c
) ;end cross
;; Tangent - Lee Mac
;; Args: x - real
(defun tan ( x )
(if (not (equal 0.0 (cos x) 1e-10))
(/ (sin x) (cos x))
)
)
; test if 3 points are collinear.
;; Collinear-p - Lee Mac
;; Returns T if p1,p2,p3 are collinear
(defun Collinear-p (p1 p2 p3)
(
(lambda (a b c)
(or
(equal (+ a b) c 1e-8)
(equal (+ b c) a 1e-8)
(equal (+ c a) b 1e-8)
)
)
(distance p1 p2)
(distance p2 p3)
(distance p1 p3)
)
)
; some function to help debugginh
(defun c:faceName (/)
(setq ss
(ssget '((0 . "3DFACE"))) ; get data for 3Dface
faceName (ssname ss 0)
)
(entget faceName)
(princ facename)
(princ)
)
(defun c:GetSlope (/ s p1 p2 data d slope)
(setq s (ssget '((0 . "line")))
data (entget (ssname s 0))
p1 (cdr (assoc 10 data))
p2 (cdr (assoc 11 data))
d (distance (list (car p1) (cadr p1))
(list (car p2) (cadr p2))
)
slope (/ (- (caddr p2) (caddr p1)) d)
)
(princ "\nSlope = ")
(princ slope)
(princ)
)
@leeminardi & @autoid374ceb4990 ,
I finally got'er done.
The attached file contains three (3) AutoLisp commands:
- 3DFace2Profile (3DF2P)
- Grade
- SlopeMap (SM)
Just finished the last one today. It creates a color coded bylayer 2DSolid for every face selected in the following format:
(setq layers
(list
'("0-2%" 51)
'("2-5%" 31)
'("5-10%" 30)
'("10-20%" 1)
'("20%+" 6)
)
where the first item in each pair is the layer name (self-explanatory) and the 2nd is the layer color.
Go ahead and change the colors to your liking (I'm really not pleased with my selection).
Don't change the layer names.
