Jump to content

Heron's formula - Help with a lisp


prodromosm
 Share

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

test.dwg

Link to comment
Share on other sites

  • Replies 48
  • Created
  • Last Reply

Top Posters In This Topic

  • prodromosm

    28

  • BIGAL

    10

  • rlx

    6

  • steven-g

    3

Top Posters In This Topic

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

 

Link to comment
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)

 

Link to comment
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

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

 

Link to comment
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)

 

 

 

Link to comment
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.

Link to comment
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.

Link to comment
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? 👨‍🎓

Link to comment
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

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

Link to comment
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?

Link to comment
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)
      (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

Link to comment
Share on other sites

Hi rlx. I have this error

 

Quote

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

 

Thanks

Link to comment
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)
      (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)
)

 

Link to comment
Share on other sites

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

Untitled-1.jpg

Link to comment
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

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

 Share


×
×
  • Create New...