Heron's formula - Help with a lisp

[Guest]

;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

test.dwg

[rlx]

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

 

[Guest]

HI rlx .

Is it possiblee to export a text like test.dwg

 

Thanks

[rlx]

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)

 

[dlanorh]

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

test.dwg 123.63 kB · 2 downloads

 

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

 

[BIGAL]

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)

 

 

 

[Guest]

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

[BIGAL]

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.

[steven-g]

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

[rlx]

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?

[steven-g]

Possibly, or maybe just overlooked 

[Guest]

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

2) Automatic add names  E1,E2,E3,.............................En

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

[steven-g]

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?

[Guest]

hI steven-g .

 

The test.dwg is a exactly what i need.

 

Thanks

test.dwg

[rlx]

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)
      (prompt "\nPoint allready entered")
      (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)
    )
  )
  (startapp "notepad" fn)
  (princ)
)

gr.Rlx

[Guest]

Hi rlx. I have this error

 

Quote

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

 

Thanks

[rlx]

oops

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

[Guest]

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)
      (prompt "\nPoint allready entered")
      (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)
    )
  )
  (startapp "notepad" fn)
  (princ)
)

 

[rlx]

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 '?'

heron.lsp

[Guest]

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