Heron's formula - Help with a lisp

Recommended Posts

```;Using Heron's formula this is the calculation to find the triangles area.
;E= √(p(p-a)(p-b)(p-c)
;where p is half the perimeter: p= (a+b+c)/2

(defun c:heron (/ p E p1 p2 p3)

(setq da (distance p2 p3))
(setq db (distance p3 p1))
(setq dc (distance p1 p2))

(setq s (/ (+ da db dc) 2.0) )

(setq E (/ (* (sqrt (* s (- s da) (- s db) (- s dc))) 2.0) dc) )

(princ (strcat "\n E = " (rtos (getvar "E") 2 2)" sqm"))
)

```

Hi. i need some help with a lisp code. I want  to calculate the area  of some triangles with  Heron's formula. Look the test.dwg

Thanks

• Replies 48
• Created

• 28

• 10

• 6

• 3

Posted Images

what's with the (getvar "E") ?

```
(defun c:heron (/ p E p1 p2 p3)
(if (and (setq p1 (getpoint "\nP1 : "))(setq p2 (getpoint "\nP2 : "))(setq p3 (getpoint "\nP3 : "))
(setq da (distance p2 p3)) (setq db (distance p3 p1)) (setq dc (distance p1 p2))
(setq s (/ (+ da db dc) 2.0) ) (setq E (/ (* (sqrt (* s (- s da) (- s db) (- s dc))) 2.0) dc) ))
(alert (strcat "\n E = " (rtos E 2 2)" sqm"))
)
)

```

Share on other sites

HI rlx .

Is it possiblee to export a text like test.dwg

Thanks

Share on other sites

15 minutes ago, prodromosm said:

HI rlx .

Is it possiblee to export a text like test.dwg

Thanks

just use vl-princ-to-string to convert any data to a string and write to a file, or something like (princ (strcat ....) file-pointer) .  Lots of examples on this site or Lee's site on how to write data to a file. Did do someting while ago with triangles here  and although it uses a table , writing a list to a table or to a file , ssdd (same , different day)

Share on other sites

5 hours ago, prodromosm said:
```
;Using Heron's formula this is the calculation to find the triangles area.
;E= √(p(p-a)(p-b)(p-c)
;where p is half the perimeter: p= (a+b+c)/2

(defun c:heron (/ p E p1 p2 p3)

(setq da (distance p2 p3))
(setq db (distance p3 p1))
(setq dc (distance p1 p2))

(setq s (/ (+ da db dc) 2.0) )

(setq E (/ (* (sqrt (* s (- s da) (- s db) (- s dc))) 2.0) dc) )

(princ (strcat "\n E = " (rtos (getvar "E") 2 2)" sqm"))
)

```

Hi. i need some help with a lisp code. I want  to calculate the area  of some triangles with  Heron's formula. Look the test.dwg

Thanks

Should be

```(setq E (sqrt (* s (- s da) (- s db) (- s dc))))
(princ (strcat "\n E = " (rtos E 2 2) " sqm"))

or you could

(princ (strcat "\n E = " (rtos E 2 2) " m" (chr 178)))```

Share on other sites

Using the formula is making hard work of it, much easier select the triangle labels sort them then just retrieve an area, let Autocad do the hard work. Do you want a table as well ?

```; 1st pass

(defun c:ahobjarea ( / obj obj2 lay x ins area)
(setq obj (vlax-ename->vla-object (car (entsel "pick text"))))
(setq lay (vla-get-layer obj))
(setq ss (ssget (list (cons 0 "text")(cons 8 lay))))
(setq x (sslength ss))
(alert (strcat "You have picked " (rtos x 2 0) " Triangles"))
(repeat x
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq ins (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
(setq objid (vla-get-textstring obj))
(command "bpoly" ins "")
(setq obj2 (vlax-ename->vla-object (entlast)))
(setq area (vla-get-area obj2))
(alert (strcat objid " = " (rtos area 2 2)))
(command "erase" (entlast) "")
)
)
(c:ahobjarea)

```

Share on other sites

Hi BIGAL. I want to create a text like the test.dwg

Share on other sites

First of why ?

2nd you can get the co-ordinates of the bpoly hence get the 3 lengths. and make text will leave that for you to do.

Share on other sites

Why Heron's formula? I'm pretty sure Lisp can use the built in "area" command and all it needs is 3 points.

Share on other sites

3 minutes ago, steven-g said:

Why Heron's formula? I'm pretty sure Lisp can use the built in "area" command and all it needs is 3 points.

school project maybe?

Share on other sites

Possibly, or maybe just overlooked

Share on other sites

is not a school project . I used an old program to do this calculations but is not working in windows 10. This program working through autocad.

1) select the triangles

3)Then insert the text with analytic calculation of the areas and the total area with Heron ' s  Formula. We use in topography Heron ' s  formula to calculate areas when we draw with triangles.

Can any one help ?

Thanks

Share on other sites

OK so it is not the solution of finding the area that is important (though it would need to be correct), you actually need to show the text in that form (as Heron's formula) as your solution, which should just be a text formatting problem?

Share on other sites

The test.dwg is a exactly what i need.

Thanks

Share on other sites

untested and almost lunchtime...

```
(defun c:heron ( / tri-no p1 p2 p3 da db dc s E cp lst cnt fn fp Etotal)
(setq tri-no 0 Etotal 0)
(while (and (setq p1 (getpoint "\nP1 : "))(setq p2 (getpoint "\nP2 : "))(setq p3 (getpoint "\nP3 : "))
(setq da (distance p2 p3)) (setq db (distance p3 p1)) (setq dc (distance p1 p2))
(setq s (/ (+ da db dc) 2.0) ) (setq E (sqrt (* s (- s da) (- s db) (- s dc)))))
; while valid points are given
(if (assoc (setq cp (tricent p1 p2 p3)) lst)
(progn
(setq lst (append lst (list (cons cp (list (setq tri-no (1+ tri-no)) s da db dc E )))))
(entmakex (list '(0 . "TEXT") (cons 10 cp) (cons 40 0.25) (cons 1 (strcat "E" (itoa tri-no)))))
)
)
)
(if (and (vl-consp lst) (setq fn (vl-filename-mktemp ".txt"))(setq fp (open fn "w")))
(progn
(foreach x lst
(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))
(write-line
(strcat "E" (vl-princ-to-string tri-no) " = V" (chr 175) " " (vl-princ-to-string s) " (" (vl-princ-to-string s)
"-" (vl-princ-to-string da) ")(" (vl-princ-to-string s) "-" (vl-princ-to-string db) ")("
(vl-princ-to-string s) "-" (vl-princ-to-string dc) ") = " (rtos E 2 2) " m" (chr 178)) fp)
(setq Etotal (+ Etotal E))
)
(write-line (strcat "E = " (vl-princ-to-string Etotal) " m" (chr 178)) fp)
(close fp)
)
)
(princ)
)

```

gr.Rlx

Share on other sites

Hi rlx. I have this error

Quote

Command: HERON
P1 :
P2 :
P3 : ; error: no function definition: TRICENT

Thanks

Share on other sites

oops

` (defun tricent (pt1 pt2 pt3)(mapcar '(lambda (x y z) (/ (+ x y z) 3)) pt1 pt2 pt3)) `

Share on other sites

Quote

P1 :
P2 :
P3 :
P1 :
; error: no function definition: WRITE-LINEΟ»Ώ

```(defun c:heron ( / tri-no p1 p2 p3 da db dc s E cp lst cnt fn fp Etotal)
(defun tricent (pt1 pt2 pt3)(mapcar '(lambda (x y z) (/ (+ x y z) 3)) pt1 pt2 pt3))
(setq tri-no 0 Etotal 0)
(while (and (setq p1 (getpoint "\nP1 : "))(setq p2 (getpoint "\nP2 : "))(setq p3 (getpoint "\nP3 : "))
(setq da (distance p2 p3)) (setq db (distance p3 p1)) (setq dc (distance p1 p2))
(setq s (/ (+ da db dc) 2.0) ) (setq E (sqrt (* s (- s da) (- s db) (- s dc)))))
; while valid points are given
(if (assoc (setq cp (tricent p1 p2 p3)) lst)
(progn
(setq lst (append lst (list (cons cp (list (setq tri-no (1+ tri-no)) s da db dc E )))))
(entmakex (list '(0 . "TEXT") (cons 10 cp) (cons 40 0.25) (cons 1 (strcat "E" (itoa tri-no)))))
)
)
)
(if (and (vl-consp lst) (setq fn (vl-filename-mktemp ".txt"))(setq fp (open fn "w")))
(progn
(foreach x lst
(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))
(write-line﻿
(strcat "E" (vl-princ-to-string tri-no) " = V" (chr 175) " " (vl-princ-to-string s) " (" (vl-princ-to-string s)
"-" (vl-princ-to-string da) ")(" (vl-princ-to-string s) "-" (vl-princ-to-string db) ")("
(vl-princ-to-string s) "-" (vl-princ-to-string dc) ") = " (rtos E 2 2) " m" (chr 178)) fp)
(setq Etotal (+ Etotal E))
)
(write-line (strcat "E = " (vl-princ-to-string Etotal) " m" (chr 178)) fp)
(close fp)
)
)
(princ)
)```

Share on other sites

looks like site is messing with codepage stuf. I'll attach the lisp file. Maybe that will help. Else open in notepad and remove all '?'

Share on other sites

nice job rlx. Is possible to  export the results with mtext. The sqrt symbol in mtext is (U+221A)

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

×   Pasted as rich text.   Restore formatting

Only 75 emoji are allowed.

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×

×
×
• Create New...