Heron's formula - Help with a lisp

July 8, 2019

Rlx go back read post wants to label the triangle so do in reverse what I did. Pick point for text label E1 etc then do bpoly write text, get area and co-ords of bpoly then get 3 side lengths as you have pt co-ords erase bpoly, write the text the way wanted but use area already found from bpoly. Picking 3 points is not required !!

July 18, 2019

is it possible to update the lisp file to export the results in autocad with a text like this ?

heron export.dwg

July 22, 2019

Is it possible to use a part of this export as block and insert the results in it. Then export all blocks with the total area like the heron export.dwg ?

thanks

July 24, 2019

Use a block like this and when insert all the areas add a total area text

Thanks

heron block.dwg

July 24, 2019

insert (setq E (sqrt (* s (- s da) (- s db) (- s dc))) into block for eatch triangle and then writ the total area

heron.dwg

Edited July 24, 2019 by prodromosm

July 25, 2019

Its your turn I turned it into a block and as I have already said just make the correct text and insert the block with 1 attribute, you have 676 posts its time to start doing it yourself.

July 25, 2019

You are right Bigal. I try this can you help me

(defun c:heronarea (/ tri-no p1 p2 p3 da db dc s E cp lst cnt fn fp Etotal)
  (vl-load-com)
  (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)))
		  )
	)
      )
    )
  )
  (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)
    )
    (progn (command "_layer" "_m" "Heron's formula" "_c" "7" "" "")
	   (setq p (getpoint "\nΣημείο εισαγωγής block"))
	   (setvar 'attreq 0)
	   (command _ "insert" heronarea.dwg "")
	   (setq b (vlax-ename->vla-object (entlast)))
	   (setq TagData			 (list (cons "En=" (vl-princ-to-string tri-no))
						       (cons "calc"
							     (strcat (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)
								     "))
                     (cons "					     area
								     " = "
								     (rtos E 2 2)
								     " m"
								     (chr 178)
							     )
							     fp
						       )


						       (setvar 'attreq 1)
						 )
		 (command "setvar" "clayer" "0")
						 (princ)
	   )
    )
  )
)

heronarea.dwg

July 26, 2019

Just did it the quick way. You need to check areas. to make sure is correct, tested on your DWG you need the block I made its in your test dwg.

If you have like this image there is a simple way around it by using layiso.

; Herons formula as text 
; who knows why
; By Alan H july 2019

(defun c:ahheron( / obj obj2 lay x ins area oldattdia)
(setq oldattdia (getvar 'attdia))
(setvar 'attdia 0)
(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 ent (car (entsel "Pick Boundary layer")))
;(command "layiso" ent "")
(setq x (sslength ss))
(alert (strcat "You have picked " (rtos x 2 0) " Triangles"))
(setq pt (getpoint "Pick top left for answer"))

(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 plent (entlast))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))))
(setq d1 (rtos (distance (nth 0 co-ord) (nth 1 co-ord)) 2 2))
(setq d2 (rtos (distance (nth 1 co-ord) (nth 2 co-ord)) 2 2))
(setq d3 (rtos (distance (nth 2 co-ord) (nth 0 co-ord)) 2 2))
(setq obj2 (vlax-ename->vla-object plent))
(setq area (vla-get-area obj2))
(setq len (rtos (/ (vla-get-length obj2) 2.0) 2 2))
(command "erase" (entlast) "")
(setq ans (strcat objid " =      " len (chr 40)  len "-" d1 (chr 41) (chr 40) len "-"  d2 (chr 41) (chr 40) len "-" d3 (chr 41) "         " (rtos area 2 2) "m" "\U+00B2"))
(command "-insert" "heronform" pt 1 1 0 ans)
(setq pt (polar pt (* 1.5 pi) 0.4))
)
;(command "layuniso")
(setvar 'attdia oldattdia)
(princ)
)
(alert "to do again type ahheron")
(c:ahheron)

test (2).dwg

Edited July 29, 2019 by BIGAL

July 28, 2019

Hi BIGAL . I can not understand how this code works.

1)I select one text example E1

2)then i select all the polylines , but the insert block is empty.

3)Why the heron form is not in en extra dwg file ?

July 29, 2019

I tested in Briscad and it may honour the -insert 2020 does not so I added attdia it works now. Code updated.

Edited July 29, 2019 by BIGAL

July 29, 2019

I have this error

Select objects: Specify opposite corner: 5 found
Select objects:
; error: no function definition: GETPOIΟ»ΏNT

; Herons formula as text 
; who knows why
; By Alan H july 2019

(defun c:ahheron( / obj obj2 lay x ins area oldattdia)
(setq oldattdia (getvar 'attdia))
(setvar 'attdia 0)
(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 ent (car (entsel "Pick Boundary layer")))
;(command "layiso" ent "")
(setq x (sslength ss))
(alert (strcat "You have picked " (rtos x 2 0) " Triangles"))
(setq pt (getpoint "Pick top left for answer"))

(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 plent (entlast))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget plent)))))
(setq d1 (rtos (distance (nth 0 co-ord) (nth 1 co-ord)) 2 2))
(setq d2 (rtos (distance (nth 1 co-ord) (nth 2 co-ord)) 2 2))
(setq d3 (rtos (distance (nth 2 co-ord) (nth 0 co-ord)) 2 2))
(setq obj2 (vlax-ename->vla-object plent))
(setq area (vla-get-area obj2))
(setq len (rtos (/ (vla-get-length obj2) 2.0) 2 2))
(command "erase" (entlast) "")
(setq ans (strcat objid " =      " len (chr 40)  len "-" d1 (chr 41) (chr 40) len "-"  d2 (chr 41) (chr 40) len "-" d3 (chr 41) "         " (rtos area 2 2) "m" "\U+00B2"))
(command "-insert" "heronform" pt 1 1 0 ans)
(setq pt (polar pt (* 1.5 pi) 0.4))
)
;(command "layuniso")
(setvar 'attdia oldattdia)
(princ)
)
(alert "to do again type ahheron")
(c:ahheron)

is it possible to insert in any file the heronform.dwg

heronform.dwg

Edited July 29, 2019 by prodromosm

July 29, 2019

Any ideas ?

Thanks

July 30, 2019

To use on any dwg open a dwg with the heron block use Ctrl+c pick block, go to new dwg and ctrl+v paste the block as is not as a block, it will then exist as a block in the dwg, you should be able to erase the dummy block. The just run code.

Use wblock to save the heron block as a dwg then you can use insert and just pick it.

Edited July 30, 2019 by BIGAL

July 30, 2019

is not working. Why i can understand why this lisp not insert the heronform block when i call the lisp. I put the lisp and the dwg file in the same folder and i select the path from the option settings !!!

I export with wblock heronform block but still not working. Works only in test2.dwg

(command "-insert" "heronform" pt 1 1 0 ans)

I can not undetrstand why with this command not insert the heroform as block into the drawing !!!

Thanks

ahheron.lsp heronform.dwg

July 30, 2019

Hi BIGAL. I update the code and the block size but i need help with the block. I want to insert the block in any drawing not only in test2.dwg

Thanks

ahheron.lsp heronform.dwg

July 30, 2019

Ok. now is working. Now i want to add a total Area at the end. Can any one help?

Thanks

ahheron.lsp heronform.dwg

July 31, 2019

ok just look at the code you need to add the following, but its your turn to work out where. You have removed the block from the dwg you posted why ?

( setq tot 0)
 …..code
 (setq tot (+ tot area))
 …..code at end
 (command "text" (polar pt 0.0 7.5) (strcat "total area is " (rtos tot 2 2)))

Edited July 31, 2019 by BIGAL

December 3, 2021

I know that the post is old. I use this code to calculater the area with heron type.

Is any way this part of the text when i paste it in Autocad to be overline??

 " (vl-princ-to-string (rtos s 2 2 )) " x (" (vl-princ-to-string (rtos s 2 2)) " - " (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 ("(vl-princ-to-string (rtos s 2 2)) " - " (vl-princ-to-string (rtos dc 2 2 )) "

(defun c:heron (/ tri-no p1 p2 p3 da db dc s E cp lst cnt fn fp Etotal)
(vl-load-com)
(setvar "OSMODE" 9) 
 (command "_layer" "_m" "Area" "_c" "7" "" "")
   (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.5) (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) " = " "\U+221A" " " (vl-princ-to-string (rtos s 2 2 )) " x (" (vl-princ-to-string (rtos s 2 2))
                  " - " (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 ("
                  (vl-princ-to-string (rtos s 2 2)) " - " (vl-princ-to-string (rtos dc 2 2 )) ") = " (rtos E 2 2) " τ.µ." ) fp)
        (setq Etotal (+ Etotal E))
      )
      (write-line (strcat "E = " (vl-princ-to-string (rtos Etotal 2 2)) " τ.µ.") fp)
      (close fp)
    )
  )
  (startapp "notepad" fn)
  (setvar "OSMODE" 9) 
  (princ)
);close defun

Thanks

December 7, 2021

Any ideas ??

Thanks

Edited December 7, 2021 by prodromosm

December 7, 2021

I find ths an overline mtext have this mode

{\Otext}

I try to inser this type in the code but the code crases. Test in simple mtext to do this and i find that i have to explode the mtext to simple text and the to convert the text to mtext and the convert it to overline text. Can any one convert the code to insert the export text with this overline type in autocad as mtext and explode it ? Then is easy to convert it again to mtext.

Thanks

(defun c:heron (/ tri-no p1 p2 p3 da db dc s E cp lst cnt fn fp Etotal)
(vl-load-com)
(setvar "OSMODE" 9) 
 (command "_layer" "_m" "Area" "_c" "7" "" "")
   (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.5) (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) " = " "\U+221A" " " (vl-princ-to-string (rtos s 2 2 )) " x (" (vl-princ-to-string (rtos s 2 2))
                  " - " (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 ("
                  (vl-princ-to-string (rtos s 2 2)) " - " (vl-princ-to-string (rtos dc 2 2 )) ") = " (rtos E 2 2) " τ.µ." ) fp)
        (setq Etotal (+ Etotal E))
      )
      (write-line (strcat "E = " (vl-princ-to-string (rtos Etotal 2 2)) " τ.µ.") fp)
      (close fp)
    )
  )
  (startapp "notepad" fn)
  (setvar "OSMODE" 9) 
  (princ)
);close defun

Heron's formula - Help with a lisp

Recommended Posts

BIGAL

Link to comment

Share on other sites

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Guest

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity