CALCULATION IN LISP
hi there,
check the following code. it creates in active layout active layer a 3-column framed mtext with slope data based on input altitude and base in active layer with active textstyle and textsize, like this:
;*************************************************************************************************************************************
; komondormrex, oct 2023
;*************************************************************************************************************************************
(vl-load-com)
;*************************************************************************************************************************************
(defun r_tos (string / chars_after_point)
(if (> 8 (setq chars_after_point (1- (- (strlen string) (vl-string-search "." string)))))
(strcat string (substr "0000000000" 1 (- 8 chars_after_point)))
string
)
)
;*************************************************************************************************************************************
(defun c:slope_mtext ( / 11\cos 1st_slope 1_cos 1_devlop 1_sin 1_tan 1_tan_b 21\cos 2nd_slope 2_cos 2_devlop 2_sin 2_tan 2_tan_b
altitude base basepoint base_point mtext_object text_scale text_size _princ
)
(setq altitude (getdist (setq basepoint (getpoint "\nPick baseboint: ")) "\nEnter altitude: ")
_princ (princ altitude)
base (getdist basepoint "\nEnter base: ")
_princ (princ base)
1st_slope (sqrt (apply '+ (mapcar 'expt (list altitude base) '(2 2))))
2nd_slope (sqrt (apply '+ (mapcar 'expt (list 1st_slope base) '(2 2))))
1_tan (/ base altitude) 2_tan (/ base 1st_slope)
1_tan_b (* 2 1_tan) 2_tan_b (* 2 2_tan)
1_sin (/ base 1st_slope) 2_sin (/ base 2nd_slope)
1_cos (/ altitude 1st_slope) 2_cos (/ 1st_slope 2nd_slope)
11\cos (/ 1st_slope altitude) 21\cos (/ 2nd_slope 1st_slope)
1_devlop (/ 2nd_slope altitude) 2_devlop 1_devlop
mtext_object (vla-addmtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(setq base_point (vlax-3d-point (getpoint "\nPick point for mtext positioning: ")))
0
"\\pxqc;"
)
)
(entmod (append (entget (vlax-vla-object->ename mtext_object)) '((75 . 1) (76 . 3))))
(setq text_scale (+ (* 1.5 (setq text_size (getvar 'textsize)))
(caadr (textbox (list '(0 . "TEXT") '(1 . "00.00000000") (cons 40 text_size) (cons 7 (getvar 'textstyle)))))
)
)
(vla-scaleentity mtext_object base_point text_scale)
(vla-put-height mtext_object text_size)
(entmod (append (entget (vlax-vla-object->ename mtext_object)) (list (cons 49 0)))) ; text_size))))
(entmod (append (entget (vlax-vla-object->ename mtext_object))
(list (cons 46 (* 1.65 8 text_size)) '(90 . 16) '(63 . 256) '(45 . 2.0) '(441 . 0)))
)
(vla-put-textstring mtext_object
(strcat (vla-get-textstring mtext_object)
"{\\L1st SLOPE}\n\n" (r_tos (rtos 1_tan 2 8)) "\n" (r_tos (rtos 1_tan_b 2 8)) "\n" (r_tos (rtos 1_sin 2 8)) "\n"
(r_tos (rtos 1_cos 2 8)) "\n" (r_tos (rtos 11\cos 2 8)) "\n" (r_tos (rtos 1_devlop 2 8)) "\\N\n\n"
"TAN\n2TAN\nSIN\nCOS\n1/COS\nDEVLOP\\N"
"{\\L2nd SLOPE}\n\n" (r_tos (rtos 2_tan 2 8)) "\n" (r_tos (rtos 2_tan_b 2 8)) "\n" (r_tos (rtos 2_sin 2 8)) "\n"
(r_tos (rtos 2_cos 2 8)) "\n" (r_tos (rtos 21\cos 2 8)) "\n" (r_tos (rtos 2_devlop 2 8))
)
)
(princ)
)
;*************************************************************************************************************************************
updated_2
Yes in autocad2011 not workiing the " komondormrex" program Lisp/..
Please, you try, other program. try pp_gaganpatel_mtext.lsp
That reason, I use many autolisp old sources of VLISP.= dfn_color_ceinc,
The😃 file "cl_aclayer_entmtext_2013_pp_gaganpatel_mtext.zip" is original-source.zip
I try to make source undertandable with math-Equations for fixing bugs of calculul, back to old-math for corections more faster, or you can adding other/s calculus of math.
Command: appload
pp_gaganpatel_mtext.lsp successfully loaded.
Command:
Command.com=C:Q2[enter]
eFileNotFound pp_markoviewcube.VLAX->h_variants
Command:
Command: q2
Select Mtext-Entity:
Pick baseboint:Draw Altitude with mouse.com
Enter base:
- Please you try your " pp_gaganpatel_mtext.lsp" programe , only inside "ciolpani_toponetracea.dwg "
- You search "berbec" with CTF+F or command (Find).
- You must see the image - logo .
- You select the entity Mtext with "Berbec" , otherwise you zoom-in the image-logo with mspaint.exe
