BIGAL Posted July 8, 2019 Posted 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 !! Quote
Guest Posted July 18, 2019 Posted 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 Quote
Guest Posted July 22, 2019 Posted 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 Quote
Guest Posted July 24, 2019 Posted July 24, 2019 Use a block like this and when insert all the areas add a total area text Thanks heron block.dwg Quote
Guest Posted July 24, 2019 Posted July 24, 2019 (edited) 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 Quote
BIGAL Posted July 25, 2019 Posted 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. Quote
Guest Posted July 25, 2019 Posted 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 Quote
BIGAL Posted July 26, 2019 Posted July 26, 2019 (edited) 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 Quote
Guest Posted July 28, 2019 Posted 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 ? Quote
BIGAL Posted July 29, 2019 Posted July 29, 2019 (edited) 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 Quote
Guest Posted July 29, 2019 Posted July 29, 2019 (edited) 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 Quote
BIGAL Posted July 30, 2019 Posted July 30, 2019 (edited) 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 Quote
Guest Posted July 30, 2019 Posted 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 Quote
Guest Posted July 30, 2019 Posted 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 Quote
Guest Posted July 30, 2019 Posted 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 Quote
BIGAL Posted July 31, 2019 Posted July 31, 2019 (edited) 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 Quote
Guest Posted December 3, 2021 Posted 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 Quote
Guest Posted December 7, 2021 Posted December 7, 2021 (edited) Any ideas ?? Thanks Edited December 7, 2021 by prodromosm Quote
Guest Posted December 7, 2021 Posted 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 Quote
Recommended Posts
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.