Topic: Help with a lisp code- heron formula

[PM]

Hi i am using this code to calculate area with heron formula.

The problem is that some times the result is not correct and i dont know why !!

I want if it possible to add a sum of all areas as text and in end of the results.

Code - Auto/Visual Lisp: [Select]

1.  
2. ; Herons formula as text
3. ; who knows why
4. ; By Alan H july 2019
5.  
6. (defun c:heron ( / obj obj2 lay x ins area oldattdia)
7. (setvar "OSMODE" 9)
8. (command "_layer" "_m" "Τύπος του Ήρωνα" "_c" "3" "" ""?)
9. (defun tricent (pt1 pt2 pt3)(mapcar '(lambda (x y z) (/ (+ x y z) 3)) pt1 pt2 pt3))
10.   (setq tri-no 0 Etotal 0)
11.   (while (and (setq p1 (getpoint "\nP1 : "))(setq p2 (getpoint "\nP2 : "))(setq p3 (getpoint "\nP3 : "))
12.               (setq da (distance p2 p3)) (setq db (distance p3 p1)) (setq dc (distance p1 p2))
13.               (setq s (/ (+ da db dc) 2.0) ) (setq E (sqrt (* s (- s da) (- s db) (- s dc)))))
14.     ; while valid points are given
15.     (if (assoc (setq cp (tricent p1 p2 p3)) lst)
16.       (prompt "\nPoint allready entered")
17.       (progn
18.         (setq lst (append lst (list (cons cp (list (setq tri-no (1+ tri-no)) s da db dc E )))))
19.         (entmakex (list '(0 . "TEXT") (cons 10 cp) (cons 40 0.25) (cons 1 (strcat "E" (itoa tri-no)))))
20.       )
21.     )
22.   )
23. (setq oldattdia (getvar 'attdia))
24. (setvar 'attdia 0)
25. (setq obj (vlax-ename->vla-object (car (entsel "pick text"))))
26. (setq lay (vla-get-layer obj))
27. (setq ss (ssget (list (cons 0 "text")(cons 8 lay))))
28. ;(setq ent (car (entsel "Pick Boundary layer")))
29. ;(command "layiso" ent "")
30. (setq x (sslength ss))
31. (alert (strcat "You have picked " (rtos x 2 0) " Triangles"))
32. (setq pt (getpoint "Pick top left for answer"))
33.  
34. (repeat x
35. (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
36. (setq ins (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
37. (setq objid (vla-get-textstring obj))
38. (command "bpoly" ins "")
39. (setq plent (entlast))
40. (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))))
41. (setq d1 (rtos (distance (nth 0 co-ord) (nth 1 co-ord)) 2 2))
42. (setq d2 (rtos (distance (nth 1 co-ord) (nth 2 co-ord)) 2 2))
43. (setq d3 (rtos (distance (nth 2 co-ord) (nth 0 co-ord)) 2 2))
44. (setq obj2 (vlax-ename->vla-object plent))
45. (setq area (vla-get-area obj2))
46. (setq len (rtos (/ (vla-get-length obj2) 2.0) 2 2))
47. (command "erase" (entlast) "")
48. (setvar "osmode" 0)
49. (setq ans (strcat objid " =       " len " x " (chr 40) len " - " d1 (chr 41) " x " (chr 40) len " - "  d2 (chr 41) " x " (chr 40) len " - " d3 (chr 41) "             " "= " (rtos area 2 2) " τ.μ"))
50. (command "-insert" "heronform" pt 1 1 0 ans)
51. ;(setq pt (polar pt (* 1.5 pi) 0.4))
52. (setq pt (polar pt (* 1.5 pi) 0.6))
53. )
54. ;(command "layuniso")
55. (setvar 'attdia oldattdia)
56. (setvar "OSMODE" 9)
57. (princ)
58. )
59.  
60.  
61.  

I upload a test.dwg with the wrong results and the heronform.dwg 

Thanks

[roy_043]

Aha, let me guess: your username used to be 'Topographer'...

[roy_043]

Source topic of the code:
https://www.cadtutor.net/forum/topic/68122-herons-formula-help-with-a-lisp/?do=findComment&comment=553435

[PM]

yes this is the old topic.But i find after some test that  this code dont work properly. Some times gives wrong results and i dont know why

[PM]

Sorry i didn't upload the test.dwg with the error  results. Can any one tell me were is the problem ?

is any other way to calculate area with heron formula and export the analytic the results for each triangle and sum them at the end?

thanks

[PM]

I want something like this in the results.

Thanks

[d2010]

I want something like this in the results.
Thanks

20.07=Hram la Biserica alba, din spatele Manastirii Antim Ivireanul
More safety,always you must use (sqrt(abs x)) and not (sqrt x).
http://lisp2arx.3xforum.ro/post/132/pp_topoxcad_vlax_-_Arien_Heron_formulas/

[roy_043]

always you must...

This is nonsense. Just look at the formula!

[PM]

can any one tell me were is the problem with this formula. The heron formula is  corect but the results is wrong

Thanks

[roy_043]

The code you are using is a bit of a mess. It cannot handle triangles that are subdivided by extra lines. You should go back to the code by rlx and work from there.

Happy coding!

[PM]

Rlx gives me this code and i did same changes in the code.

Code - Auto/Visual Lisp: [Select]

1. (defun c:heron ( / tri-no p1 p2 p3 da db dc s E cp lst cnt fn fp Etotal)(vl-load-com)
2.   (defun tricent (pt1 pt2 pt3)(mapcar '(lambda (x y z) (/ (+ x y z) 3)) pt1 pt2 pt3))
3.   (setq tri-no 0 Etotal 0)
4.   (while (and (setq p1 (getpoint "\nP1 : "))(setq p2 (getpoint "\nP2 : "))(setq p3 (getpoint "\nP3 : "))
5.               (setq da (distance p2 p3)) (setq db (distance p3 p1)) (setq dc (distance p1 p2))
6.               (setq s (/ (+ da db dc) 2.0) ) (setq E (sqrt (* s (- s da) (- s db) (- s dc)))))
7.     ; while valid points are given
8.     (if (assoc (setq cp (tricent p1 p2 p3)) lst)
9.       (prompt "\nPoint allready entered")
10.       (progn
11.         (setq lst (append lst (list (cons cp (list (setq tri-no (1+ tri-no)) s da db dc E )))))
12.         (entmakex (list '(0 . "TEXT") (cons 10 cp) (cons 40 0.25) (cons 1 (strcat "E" (itoa tri-no)))))
13.       )
14.     )
15.   )
16.   (if (and (vl-consp lst) (setq fn (vl-filename-mktemp ".txt"))(setq fp (open fn "w")))
17.     (progn
18.       (foreach x lst
19.         (setq x (cdr x) tri-no (nth 0 x) s (nth 1 x) da (nth 2 x) db (nth 3 x) dc (nth 4 x) E (last x))
20.         (write-line
21.           (strcat "E" (vl-princ-to-string tri-no) " = V" (chr 175) " " (vl-princ-to-string (rtos s 2 2 )) " x (" (vl-princ-to-string (rtos s 2 2))
22.                   "-" (vl-princ-to-string (rtos da 2 2 )) ") x (" (vl-princ-to-string (rtos s 2 2)) "-" (vl-princ-to-string (rtos db 2 2 )) ") x ("
23.                   (vl-princ-to-string (rtos s 2 2)) "-" (vl-princ-to-string (rtos dc 2 2 )) ") = " (rtos E 2 2) " m" (chr 178)) fp)
24.         (setq Etotal (+ Etotal E))
25.       )
26.       (write-line (strcat "E = " (vl-princ-to-string (rtos Etotal 2 2)) " m" (chr 178)) fp)
27.       (close fp)
28.     )
29.   )
30.   (startapp "notepad" fn)
31.   (princ)
32. )
33.  
34.  

Now the results is correct but export in notepad. I want to use the  heronform.dwg  in the export is in possible

Thanks

[PM]

in the export text is exactly what i need. Can any one help?

Thanks

[PM]

Any option ?

Thanks

[PM]

is it possible to insert two blocks like heronform1.dwg and heronform2.dwg to get the results ?

Thaks