Jump to content

Heron's formula - Help with a lisp


prodromosm
 Share

Recommended Posts

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

Link to comment
Share on other sites

  • 2 weeks later...
  • 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

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

Link to comment
Share on other sites

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 by prodromosm
Link to comment
Share on other sites

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.

image.thumb.png.7a835202cc412f14dc2193e6c03338b6.png

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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)

 

image.thumb.png.d53bdc1312cab6db2c4176d08760fe0f.png

test (2).dwg

Edited by BIGAL
Link to comment
Share on other sites

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 ?

test.jpg

Link to comment
Share on other sites

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

Edited by BIGAL
Link to comment
Share on other sites

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 by prodromosm
Link to comment
Share on other sites

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 by BIGAL
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by BIGAL
Link to comment
Share on other sites

  • 2 years later...

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

Link to comment
Share on other sites

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

 

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