What i mistake Three Point Triangle

What i mistake Three Point Triangle

jaimuthu
Advocate Advocate
573 Views
3 Replies
Message 1 of 4

What i mistake Three Point Triangle

jaimuthu
Advocate
Advocate

*Moderator restored to original text- please see message 1 for additional information. 

 

What i mistake this program

1) I want A(P1),B(P2),C(P3) triangle

2) Existing Lenght AB

3)Find P3 Point & A to C Angle Using this formula ∠A = arccos(b2 + c2 - a2) / 2bc

4) I pick 2 points and side values

5) Mistake for this program not correct dimension and angles

 

 

(defun c:tri( / unit mxv v^v transptucs transptwcs p1 p2 loop g p h gp p3 )

(defun acos ( x )

(if (<= -1.0 x 1.0)

(atan (sqrt (- 1.0 (* x x))) x)

)



)
(defun unit ( v / d )
(mapcar '(lambda ( x y ) (/ x y)) v (list (setq d (distance '(0.0 0.0 0.0) v)) d d))
)

(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

(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)))
)
)

(defun transptucs ( pt p1 p2 p3 / ux uy uz )
(setq uz (unit (v^v (mapcar '- p2 p1) (mapcar '- p3 p1))))
(setq ux (unit (mapcar '- p2 p1)))
(setq uy (unit (mapcar '- p3 p1)))

(mxv (list ux uy uz) (mapcar '- pt p1))
)

(defun transptwcs ( pt pt1 pt2 pt3 / pt1n pt2n pt3n )
(setq pt1n (transptucs '(0.0 0.0 0.0) pt1 pt2 pt3))
(setq pt2n (transptucs '(1.0 0.0 0.0) pt1 pt2 pt3))
(setq pt3n (transptucs '(0.0 1.0 0.0) pt1 pt2 pt3))
(transptucs pt pt1n pt2n pt3n)
)

(setq p1 (getpoint "\nPick or specify start point : "))
(setq p2 (getpoint "\nPick or specify end point : " p1))

(SETQ
TA(GETSTRING "\n ENTER START POINT OF TEXT:");A

TB(GETSTRING "\n ENTER END POINT OF TEXT:");B

TC(GETSTRING "\n ENTER THIRD POINT OF TEXT:");C

AB(GETDIST(STRCAT TA "<----->" TB " LENGTH"));AB - C

BC(GETDIST(STRCAT TB "<----->" TC " LENGTH"));BC - A

CA(GETDIST(STRCAT TC "<----->" TA " LENGTH"));CA - B


B2(* CA CA) C2(* AB AB) A2(* BC BC) CV(* 2 CA AB) CB(* 2 BC AB) CC(* 2 BC CA)

ANGA(/(-(+ B2 C2)A2)CV)

ANSA(acos anga);ANGLE A

)

(setq loop t)
(while loop
(setq g (grread t 15 0))
(if (eq (car g) 5)
(progn
(setq p (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) p1 p2))
(setq h (/ (distance p1 p2) (* 2.0 (sqrt 3.0))))
(setq gp (cadr g))
(if (not (minusp (cadr (transptucs gp p1 (polar p1 (angle p1 p2) 1.0) (polar p1 (+ (angle p1 p2) (* 0.5 pi)) 1.0)))))
(progn
(redraw)
(setq p3 (polar p ANSA CA))
(grdraw p1 p2 1 1)
(grdraw p2 p3 1 1)
(grdraw p3 p1 1 1)
)
(progn
(redraw)
(setq p3 (polar p (- ANSA) CA))
(grdraw p1 p2 1 1)
(grdraw p2 p3 1 1)
(grdraw p3 p1 1 1)
)
)
)


(progn
(entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 3) (if (eq (getvar 'plinegen) 1) '(70 . 129) '(70 . 1)) (cons 38 (caddr (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t)))) (cons 10 (list (car (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t))) (cadr (trans p1 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 10 (list (car (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t))) (cadr (trans p2 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 10 (list (car (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t))) (cadr (trans p3 1 (trans '(0.0 0.0 1.0) 1 0 t))))) (cons 210 (trans '(0.0 0.0 1.0) 1 0 t))))
(setq loop nil)
)


)
)

(redraw)
(princ (RTOS ANSA))
)

0 Likes
Accepted solutions (1)
574 Views
3 Replies
Replies (3)
Message 2 of 4

CADaSchtroumpf
Advisor
Advisor
Accepted solution

You can try my solution which is similar to your approach.

(defun 2xderr (ch)
  (cond
    ((eq ch "Function cancelled") nil)
    ((eq ch "quit / exit abort") nil)
    ((eq ch "console break") nil)
    (T (princ ch))
  )
  (setvar "cmdecho" v1)
  (setvar "orthomode" v2)
  (setvar "osmode" v3)
  (setvar "blipmode" v4)
  (setvar "plinewid" v5)
  (setq *error* olderr)
  (princ)
)
(defun c:2xd ( / v1 v2 v3 v4 v5 cc1 r1 cc2 r2 dce xi yi i cr1 cr2 vi xt yt h1 h2 h i1 i2 ss1 ss2 key olderr)
    (setq v1 (getvar "cmdecho")
          v2 (getvar "orthomode")
          v3 (getvar "osmode")
          v4 (getvar "blipmode")
          v5 (getvar "plinewid")
    ) 
    (setvar "cmdecho" 0)
    (setvar "orthomode" 0)
    (setvar "blipmode" 0)
    (setvar "plinewid" 0)
    (setq olderr *error* *error* 2xderr)	
    (initget 9)
    (setq cc1 (getpoint "\nFirst base point?: "))
    (initget 9)
    (setq cc2 (getpoint cc1 "\nSecond base point?: "))
    (grdraw cc1 cc2 1)
    (initget 39)
    (setq r1 (getdist cc1 "\nGive the 1st radiant distance: "))
    (initget 39)
    (setq r2 (getdist cc2 "\nGive the 2nd radiant distance: "))
    (grdraw cc1 cc2 0)
    (setvar "osmode" 0)
    (setq dce (distance cc1 cc2))
    (if (= (rtos (/ dce (+ r1 r2)) 2 12) "1.000000000000")
        (progn
            (setq xi (/ (+ (* r2 (car cc1)) (* r1 (car cc2))) dce)
                  yi (/ (+ (* r2 (cadr cc1)) (* r1 (cadr cc2))) dce))
            (setq i (cons xi (cons yi '(0.0))))
        )
        (if (and (not (zerop (- r1 r2))) (= (rtos (/ dce (abs (- r1 r2))) 2 12) "1.000000000000"))
            (progn
                (if (= r1 (max r1 r2))
                    (setq cr1 cc1 cr2 cc2)
                    (setq cr1 cc2 cr2 cc1)
                )
                (setq xi (/ (- (* (max r1 r2) (car cr2)) (* (min r1 r2) (car cr1))) dce)
                      yi (/ (- (* (max r1 r2) (cadr cr2)) (* (min r1 r2) (cadr cr1))) dce))
                (setq i (cons xi (cons yi '(0.0))))
            )
            (progn
                (if (or (> dce (+ r1 r2)) (< (+ (min r1 r2) dce) (max r1 r2)))
                    (prompt "\nNo intersection!...")
                    (progn
                        (setq vi (angle cc1 cc2))
                        (if (> r1 r2)
                            (setq xt (- (/ (* (+ r1 dce r2) (- (+ r1 dce) r2)) (* 2 dce)) r1)
                                  yt (- dce xt)
                                  h1 (sqrt (- (expt r1 2) (expt xt 2)))
                                  h2 (sqrt (- (expt r2 2) (expt yt 2)))
                                  xi (/ (+ (* yt (car cc1)) (* xt (car cc2))) dce)
                                  yi (/ (+ (* yt (cadr cc1)) (* xt (cadr cc2))) dce)
                            )
                            (setq xt (- (/ (* (+ r2 dce r1) (- (+ r2 dce) r1)) (* 2 dce)) r2)
                                  yt (- dce xt)
                                  h1 (sqrt (- (expt r2 2) (expt xt 2)))
                                  h2 (sqrt (- (expt r1 2) (expt yt 2)))
                                  xi (/ (+ (* xt (car cc1)) (* yt (car cc2))) dce)
                                  yi (/ (+ (* xt (cadr cc1)) (* yt (cadr cc2))) dce)
                            )
                        )
                        (setq h (/ (+ h1 h2) 2)
                              i1 (polar (cons xi (cons yi '(0.0))) (+ vi (/ pi 2)) h)
                              i2 (polar (cons xi (cons yi '(0.0))) (- vi (/ pi 2)) h)
                        )
                        (if (zerop (getvar "PICKFIRST")) (setvar "PICKFIRST" 1))
                        (command "_.pline" cc1 i1 cc2 "")
                        (setq ss1 (ssget "_L"))
                        (command "_.pline" cc1 i2 cc2 "")
                        (setq ss2 (ssget "_L"))
                        (if (and ss1 ss2 (= 0 (getvar "CMDACTIVE"))) 
                          (progn
                            (sssetfirst nil ss2)
                            (princ "\n<Move Cursor> for choice; <Enter>/[Space]/Right+click to finish!.")
                            (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
                              (cond
                                ((eq (car key) 5)
                                  (if (< (distance i1 (cadr key)) (distance i2 (cadr key)))
                                    (sssetfirst nil ss1)
                                    (sssetfirst nil ss2)
                                  )
                                )
                              )
                            )
                          )
                        )
                        (command "_.erase")
                    )
                )
            )
        )
    )
    (setvar "cmdecho" v1)
    (setvar "orthomode" v2)
    (setvar "osmode" v3)
    (setvar "blipmode" v4)
    (setvar "plinewid" v5)
    (setq *error* olderr)
    (prin1)
)
0 Likes
Message 3 of 4

jaimuthu
Advocate
Advocate

Thanks  Its Work Fine 

0 Likes
Message 4 of 4

jaimuthu
Advocate
Advocate

i want some text string for this program  

ex:

1) variable cc1 First base point ------------- put text value for TA variable (A)

2) variable cc2 Second base point -----------put text value for TB variable (B)

3) variable i1 or i2   -----------put text value for TC variable (C)

and

4) cc1 to i1 Distance value for side

5) cc1 to i2 Distance value for side

 

 

I TRY THIS BUT TEXT IS ONE SIDE PLINE IS BOTH SIDE SHOW

(defun 2xderr (ch)
(cond
((eq ch "Function cancelled") nil)
((eq ch "quit / exit abort") nil)
((eq ch "console break") nil)
(T (princ ch))
)
(setvar "cmdecho" v1)
(setvar "orthomode" v2)
(setvar "osmode" v3)
(setvar "blipmode" v4)
(setvar "plinewid" v5)
(setq *error* olderr)
(princ)
)
(defun c:2xd ( / v1 v2 v3 v4 v5 cc1 r1 cc2 r2 dce xi yi i cr1 cr2 vi xt yt h1 h2 h i1 i2 ss1 ss2 key olderr)
(setq v1 (getvar "cmdecho")
v2 (getvar "orthomode")
v3 (getvar "osmode")
v4 (getvar "blipmode")
v5 (getvar "plinewid")
)

(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "blipmode" 0)
(setvar "plinewid" 0)
(setq olderr *error* *error* 2xderr)
(initget 9)
(setq cc1 (getpoint "\nFirst base point?: "))
(initget 9)
(setq cc2 (getpoint cc1 "\nSecond base point?: "))
(grdraw cc1 cc2 1)
(initget 39)

(setq
TA(GETSTRING "\n ENTER START POINT OF TEXT:");A

TB(GETSTRING "\n ENTER END POINT OF TEXT:");B

TC(GETSTRING "\n ENTER THIRD POINT OF TEXT:");C

D1(DISTANCE cc1 cc2)AN1(ANGLE cc1 cc2)

c1(/ 180 pi)

c4(* c1 AN1)

)
(setq r1 (getdist cc1 "\nGive the 1st radiant distance: "))
(initget 39)
(setq r2 (getdist cc2 "\nGive the 2nd radiant distance: "))
(grdraw cc1 cc2 0)
(setvar "osmode" 0)
(setq dce (distance cc1 cc2))
(if (= (rtos (/ dce (+ r1 r2)) 2 12) "1.000000000000")
(progn
(setq xi (/ (+ (* r2 (car cc1)) (* r1 (car cc2))) dce)
yi (/ (+ (* r2 (cadr cc1)) (* r1 (cadr cc2))) dce))
(setq i (cons xi (cons yi '(0.0))))
)
(if (and (not (zerop (- r1 r2))) (= (rtos (/ dce (abs (- r1 r2))) 2 12) "1.000000000000"))
(progn
(if (= r1 (max r1 r2))
(setq cr1 cc1 cr2 cc2)
(setq cr1 cc2 cr2 cc1)
)
(setq xi (/ (- (* (max r1 r2) (car cr2)) (* (min r1 r2) (car cr1))) dce)
yi (/ (- (* (max r1 r2) (cadr cr2)) (* (min r1 r2) (cadr cr1))) dce))
(setq i (cons xi (cons yi '(0.0))))
)
(progn
(if (or (> dce (+ r1 r2)) (< (+ (min r1 r2) dce) (max r1 r2)))
(prompt "\nNo intersection!...")
(progn
(setq vi (angle cc1 cc2))
(if (> r1 r2)
(setq xt (- (/ (* (+ r1 dce r2) (- (+ r1 dce) r2)) (* 2 dce)) r1)
yt (- dce xt)
h1 (sqrt (- (expt r1 2) (expt xt 2)))
h2 (sqrt (- (expt r2 2) (expt yt 2)))
xi (/ (+ (* yt (car cc1)) (* xt (car cc2))) dce)
yi (/ (+ (* yt (cadr cc1)) (* xt (cadr cc2))) dce)
)
(setq xt (- (/ (* (+ r2 dce r1) (- (+ r2 dce) r1)) (* 2 dce)) r2)
yt (- dce xt)
h1 (sqrt (- (expt r2 2) (expt xt 2)))
h2 (sqrt (- (expt r1 2) (expt yt 2)))
xi (/ (+ (* xt (car cc1)) (* yt (car cc2))) dce)
yi (/ (+ (* xt (cadr cc1)) (* yt (cadr cc2))) dce)
)
)
(setq h (/ (+ h1 h2) 2)
i1 (polar (cons xi (cons yi '(0.0))) (+ vi (/ pi 2)) h)
i2 (polar (cons xi (cons yi '(0.0))) (- vi (/ pi 2)) h)
)
(if (zerop (getvar "PICKFIRST")) (setvar "PICKFIRST" 1))
;(COMMAND "TEXT" "J" "BC" cc1 8 C4 TA "")
(command "_.pline" cc1 i1 cc2 "")
(setq ss1 (ssget "_L"))
(command "_.pline" cc1 i2 cc2 "")

(setq ss2 (ssget "_L"))
(if (and ss1 ss2 (= 0 (getvar "CMDACTIVE")))
(progn
(sssetfirst nil ss2)
(princ "\n<Move Cursor> for choice; <Enter>/[Space]/Right+click to finish!.")
(while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
(cond
((eq (car key) 5)
(if (< (distance i1 (cadr key)) (distance i2 (cadr key)))
(sssetfirst nil ss1)
(sssetfirst nil ss2)
)
)
)
)
)
)

(command "_.erase" )

 

(COMMAND "TEXT" "J" "BC" cc1 8 C4 TA "")

;(COMMAND "TEXT" "J" "BC" cc2 8 C4 TB "")

;(COMMAND "TEXT" "J" "BC" i1 8 C4 TC "")


)
)
)
)
)
(setvar "cmdecho" v1)
(setvar "orthomode" v2)
(setvar "osmode" v3)
(setvar "blipmode" v4)
(setvar "plinewid" v5)
(setq *error* olderr)
(redraw)
(prin1)

 

 

 

 

)

0 Likes