Topic: Calculate point inside triangle

[TopoWAR]

Hello to all! I have a little problem, to calculate the elevation of a point x in a triangle '(p1 p2 p3) use (c: cal "ilp (PV1, PV2, p11, p21, p31)") but it now occupies this calculation Bricscad, I come with the surprise that I no longer command works geomcal.arx lime because it belongs to, the question is how I can calculate this elevation to pure lisp code, thanks

[ElpanovEvgeniy]

I do not understand your question.
Write all the arguments and the desired result.
Best of all, if you add a picture.

PS. I never used the function of c:cal

[David Bethel]

Given:
  The 3 points making the plane cannot be colinear
  All points are WCS

A simple way could be:

Code: [Select]


  (setq x '(1 1 1)
       p1 '(0 2 0)
       p2 '(2 0 1)
       p3 '(1 4 3))

  (command "_.UCS" "_W"
           "_.UCS" "_3P" p1 p2 p3)
  (setq pv (trans x 0 1))
  (command "_.UCS" "_P"
           "_.UCS" "_P")


Determining the ucs direction extrution can be calculated, I just couldn't find the code in my libraries.  -David

[Lee Mac]

Was that what was required? 

If so, here's another way using trans

Code: [Select]

(defun PointElevation ( pt p1 p2 p3 )
    (   (lambda ( n ) (- (caddr (trans pt 0 n)) (caddr (trans p1 0 n))))
        (v^v (mapcar '- p1 p2) (mapcar '- p3 p2))
    )
)

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
    (list
        (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
        (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
    )
)


[Lee Mac]

Another, using vector calculus instead:

Code: [Select]

(defun PointElevation ( pt p1 p2 p3 )
    (vxv (v1 (v^v (mapcar '- p1 p2) (mapcar '- p3 p2))) (mapcar '- pt p1))
)

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
    (list
        (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
        (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
        (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
    )
)

;; Vector Dot Product - Lee Mac
;; Args: u,v - vectors in R^n

(defun vxv ( u v )
    (apply '+ (mapcar '* u v))
)

;; Unit Vector - Lee Mac
;; Args: v - vector in R^2 or R^3

(defun v1 ( v )
    (   (lambda ( d ) (if (equal 0.0 d 1e-14) nil (mapcar '/ v (list d d d))))
        (distance '(0.0 0.0 0.0) v)
    )
)

[ribarm]

Try this :

Code: [Select]

;; Vector Cross Product - Lee Mac
;; Args: u,v - vectors in R^3

(defun v^v ( u v )
  (list
    (- (* (cadr u) (caddr v)) (* (cadr v) (caddr u)))
    (- (* (car  v) (caddr u)) (* (car  u) (caddr v)))
    (- (* (car  u) (cadr  v)) (* (car  v) (cadr  u)))
  )
)

;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun unit ( v )
  ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (vxs v (/ 1.0 n)))) (norm v))
)

;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun vxs ( v s )
  (mapcar '(lambda ( n ) (* n s)) v)
)

;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun norm ( v )
  (sqrt (apply '+ (mapcar '* v v)))
)

(defun c:int-line-plane ( / pt1 pt2 pt3 ptl1 ptl2 pt1w pt2w pt3w ptl1w ptl2w u v n ptl1n ptl2n pt1n pt4l1n pt4l2n pt4l1w pt4l2w )
  (if (setq pt1 (getpoint "\nFirst point on plane : ")
            pt2 (getpoint "\nSecond point on plane : " pt1)
            pt3 (getpoint "\nThird point on plane : " pt1)
            ptl1  (getpoint "\nStart point on line : ")
            ptl2  (getpoint "\nEnd point on line : " ptl1)
      )
      (progn
        (setq pt1w (trans pt1 1 0)
              pt2w (trans pt2 1 0)
              pt3w (trans pt3 1 0)
              ptl1w  (trans ptl1 1 0)
              ptl2w  (trans ptl2 1 0)
        )
        (setq u (mapcar '- pt2w pt1w))
        (setq v (mapcar '- pt3w pt1w))
        (setq n (unit (V^V u v)))
        (setq ptl1n (trans ptl1w 0 n))
        (setq ptl2n (trans ptl2w 0 n))
        (setq pt1n (trans pt1w 0 n))
        (setq pt4l1n (list (car ptl1n) (cadr ptl1n) (caddr pt1n)))
        (setq pt4l2n (list (car ptl2n) (cadr ptl2n) (caddr pt1n)))
        (setq pt4l1w (trans pt4l1n n 0))
        (setq pt4l2w (trans pt4l2n n 0))
        (setq ppw (inters ptl1w ptl2w pt4l1w pt4l2w nil))
        (setq ppu (trans ppw 0 1))
        (entmakex (list '(0 . "LINE") (cons 10 pt1w) (cons 11 pt2w)))
        (entmakex (list '(0 . "LINE") (cons 10 pt2w) (cons 11 pt3w)))
        (entmakex (list '(0 . "LINE") (cons 10 pt3w) (cons 11 pt1w)))
        (entmakex (list '(0 . "LINE") (cons 10 ptl1w) (cons 11 ptl2w)))
        (entmakex (list '(0 . "POINT") (cons 10 ppw)))
        (setvar 'pdmode 35)
        (prompt "\nIntersection point of specified line and plane in WCS is : ")(princ ppw)(prompt " ; in current UCS is : ")(princ ppu)
        (prompt "\nYou can call intersection point with !ppw for WCS and !ppu for UCS")
        (textpage)
      )
  )
(princ)
)

M.R.

[TopoWAR]

thanks for the help, I have found the answer to my question, gerardogqa made ​​code of hispacad.

Code: [Select]

(defun c:test ( / ptX pt1 pt2 pt3 pt1z0 pt2z0 pt3z0 ptXz0 pt4z0 Z4)
    (setq ptX (getpoint "\npoint inside the triangle:")
     pt1 (getpoint "\npoint 1 of triangle:")
     pt2 (getpoint "\npoint 2 of triangle:")
     pt3 (getpoint "\npoint 3 of triangle:")
     pt1z0 (list (car pt1)(cadr pt1))
     pt2z0 (list (car pt2)(cadr pt2))
     pt3z0 (list (car pt3)(cadr pt3))
     ptXz0 (list (car ptX)(cadr ptX))
     pt4z0 (inters pt1z0 ptXz0 pt2z0 pt3z0 nil)
     Z4 (+ (/ (* (distance pt2z0 pt4z0) (- (last pt3)(last pt2))) (distance pt2z0 pt3z0)) (last pt2))
     pt4 (list (car pt4z0)(cadr pt4z0) Z4)
     ZX (+ (/ (* (distance pt4z0 ptXz0) (- (last pt1) Z4)) (distance pt1z0 pt4z0)) Z4)
    )
    (alert (strcat "En el punto indicado (" (rtos (car ptX) 2) ", " (rtos (cadr ptX) 2) "), sobre\nel plano del triangulo la elevacion es: " (rtos ZX 2)))
)

[chlh_jd]

Code: [Select]

(defun EE:pitp (p l)
  ;; check is a point inside the triangle.
  ;; by ElpanovEvgeniy
  (if (vl-some (function (lambda (x) (equal p x 1e-6)))
       l
      )
    T
    (if (< (sin (- (angle (last l) p) (angle (last l) (car l))))
   -1e-6
)
      (vl-every
(function
  (lambda (a b) (< (sin (- (angle a p) (angle a b))) -1e-6))
)
l
(cdr l)
      )
      (vl-every
(function
  (lambda (a b) (> (sin (- (angle a p) (angle a b))) 1e-6))
)
l
(cdr l)
      )
    )
  )
)
;;;is outside of triangle
(defun ss-ostp (p p1 p2 p3)
      ;;Gile & Lee Mac
      ((lambda (a b c)
(not
   (or
     (and (< 1e-6 a) (< 1e-6 b) (< 1e-6 c))
     (and (< a -1e-6) (< b -1e-6) (< c -1e-6))
   ) ;_if at triangle edge, so add tolerance
)
       )
(sin (- (angle p1 p) (angle p1 p2)))
(sin (- (angle p2 p) (angle p2 p3)))
(sin (- (angle p3 p) (angle p3 p1)))
      )   
  )