Anuncios

The Autodesk Community Forums has a new look. Read more about what's changed on the Community Announcements board.

leeminardi
en respuesta a: autoid374ceb4990

@autoid374ceb4990 Here's a program that will project a give point vertically to a selected 3dface and determine the downward slope point of exit for a drop of water. The program determines if the projected given point is within the bounds of the face. It igores faces that are vertical although I am not sure this is a needed limiation.
To test it create a 3DFACE that is not parallel to the WCS XY plane, go to the top view and specify a point.

The next step is to enable the selection of multiple 3dfaces and compute the slope lines from one face to the next. Is this something you would use?

 

leeminardi_0-1716213905916.pngleeminardi_1-1716213989557.png

; Calculates the point on a 3Dface vertically aboce a given point and the
; the point on its edge downslope from the point on the 3dface.
; L. Minardi  5/20/2024

(defun c:FaceSlope (/ ss en edata pxy p A B C N Apxy verticalFace tk x1 x2 x3 qlist w q1 q2 q3 q)
  (princ "\nPlease select 3DFACE and press ENTER.")
  (setq	ss    (ssget '((0 . "3DFACE") ))			; get data for 3Dface
	en    (ssname ss 0)
	edata (entget en)
  )
  (setq	pxy   (getpoint "\nEnter point under face:")	; a point
	p   (mapcar '+ pxy '(0 0 1))  ; point above pxy
  )
  (setq	A (cdr (assoc 10 edata))	;three corners of the 3DFACE
	B (cdr (assoc 11 edata))
	C (cdr (assoc 12 edata))
  )
;;;  (setq	AB (mapcar '- B A)	;define vectors along edges of face
;;;	BC (mapcar '- C B)
;;;  )
  (setq N (cross (mapcar '- B A) (mapcar '- C B)))		; normal to face
  (setq	Apxy (mapcar '- pxy A)	; vector from face to pxy
  )
;;;; determine if face is vertical
(if (< (abs (caddr n)) 0.00001)
  (setq verticalFace T)
  (setq verticalFace nil)
)
  (if verticalFace
    (princ
      "\nVertical face."
    )
    (progn ; face not vertical, continue
      (setq tk (- (/ (dot N Apxy) (dot N '(0 0 1))))
	; value of parameter t at intersection
      )		; intersection point of line and face using parametric definition of a line  
      (setq P (mapcar '+ ; redefine p as point of face 
			 pxy
			 (mapcar '* (mapcar '- p pxy) (list tk tk tk))
		 )
      )
      (command "point" "_non" P)
      ; determine if point is inside face boundary
(setq x1 (dot N (cross (mapcar '- P A) AB))
      x2 (dot N (cross (mapcar '- P B) BC))
      x3 (dot N (cross (mapcar '- P C) CA))
)
(if  ;test inside
  (or
    (and (>= x1 0) (>= x2 0) (>= x3 0))
    (and (<= x1 0) (<= x2 0) (<= x3 0))
  )
(progn
  ;(princ "\nThe intersection point is INSIDE the Face")
  (setq qlist nil) ; list of valid intersections of slope line from p
  (setq w (cross N (cross N '(0 0 1)))) ; downslope vector
  (setq q1 (inters A B P (mapcar '+ P W) nil))
  (if (onSegment A B q1) 
    (setq qlist (append qlist (list q1)))
  )
  (setq q2 (inters B C P (mapcar '+ P W) nil))
  (if (onSegment B C q2)
    (setq qlist (append qlist (list q2)))
  )
  (setq q3 (inters C A P (mapcar '+ P W) nil))
  (if (onSegment C A q3)
    (setq qlist (append qlist (list q3)))
  )
; which intersection point has the lowest z coordinate
  (if (< (caddr (car qlist)) (caddr (cadr qlist)))
	 (setq q (car qlist))
    (setq q (cadr qlist))) ; point on face edge downslope from p
  (command "_point" "_non" q)
  (command "_line" "_non" p "_non" q "")
)					; end progn	
   (princ "\nThe intersection point is OUTSIDE the Face")
)  ;end if test inside outside
)
)	; end if vertical face

  (princ)
)					;end Face-Intr



; Determines if the projection of point pt is on the
; line segment from point p1 to p2. True if it is,
; nil if it isn't.
(defun onSegment (p1 p2 pt / x v ti)
  (setq x (distance p1 p2))
  (setq v (mapcar '/ (mapcar '- p2 p1) (list x x x)))
  (setq	ti (/ (dot (mapcar '- pt p1) v)
	      (dot (mapcar '- p2 p1) v)
	   )
  )
  (if (and (>= ti 0) (<= ti 1.))
    (setq x T)
    (setq x nil)
  )
)
  
;;; Compute the 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
;;; Compute the dot product of 2 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
; Unit vector of v
(defun unitvec (v / x)
  (setq	x (distance '(0 0 0) v)
	x (mapcar '/ v (list x x x))
  )
)
lee.minardi