E = 1/2 x (a+b) x h
Code: Select all
(defun c:areacal ( / js nb ent dxf_ent ptlst surf n AcDoc Space old_textsize count app_txt cum_area pt_ins val_txt lst_bis l_4d max_d pos pt1 pt2 pt3 d1 d2 nw_obj ent_text key)
(command "_layer" "_m" "AREA CALC" "_c" "7" "" "")
(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "n" "n" "n")
(while (null (setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . ">") (90 . 2) (-4 . "<") (90 . 5) (-4 . "AND>"))))))
(repeat (setq nb (sslength js))
(setq
ent (ssname js (setq nb (1- nb)))
dxf_ent (entget ent)
ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
n (length ptlst)
)
(if (eq n 4)
(if (not (and (equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)) 1E-08)))
(ssdel ent js)
)
)
)
(cond
((and js (> (sslength js) 0))
(sssetfirst nil js)
(initget "Yes No")
(cond
((not (eq (getkword "\n Insert calculations [Yes/No]? <Yes>: ") "No"))
(sssetfirst nil nil)
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
old_textsize (getvar "TEXTSIZE")
count 0
app_txt ""
cum_area 0.0
)
(setvar "TEXTSIZE" 2.5)
(repeat (setq nb (sslength js))
(setq
ent (ssname js (setq nb (1- nb)))
dxf_ent (entget ent)
ptlst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent))
n (length ptlst)
pt_ins (list (/ (apply '+ (mapcar 'car ptlst)) n) (/ (apply '+ (mapcar 'cadr ptlst)) n))
val_txt
(if (eq n 3)
(progn
(setq
lst_bis (append (cdr ptlst) (list (car ptlst)))
l_4d (mapcar 'distance ptlst lst_bis)
max_d (apply 'max l_4d)
pos (vl-position max_d l_4d)
pt1 (nth pos ptlst)
pt2 (nth pos lst_bis)
pt3 (car (vl-remove pt2 (vl-remove pt1 ptlst)))
d1
(distance
pt3
(inters
pt1
pt2
pt3
(polar pt3 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
nil
)
)
surf (* (atof(rtos max_d 2 2)) (atof (rtos d1 2 2)) 0.5)
cum_area (atof (rtos (+ surf cum_area) 2 2))
)
(strcat
"Ε" (itoa (setq count (1+ count))) " = "
"1/2 x "
(rtos max_d 2 2)
" x "
(rtos d1 2 2)
" = "
(rtos surf 2 2) " sq.m\\P"
)
)
(progn
(setq
d1 (atof (rtos (distance (car ptlst) (cadr ptlst)) 2 2))
d2 (atof (rtos (distance (cadr ptlst) (caddr ptlst)) 2 2))
surf (atof (rtos (* d1 d2) 2 2))
cum_area (atof (rtos (+ surf cum_area) 2 2))
)
(strcat
"Ε" (itoa (setq count (1+ count))) " = "
(rtos d1 2 2)
" x "
(rtos d2 2 2)
" = "
(rtos surf 2 2)
" sq.m\\P"
)
)
)
app_txt (strcat app_txt val_txt)
)
(entmake
(list
'(0 . "TEXT")
'(100 . "AcDbEntity")
(cons 8 (getvar "CLAYER"))
'(100 . "AcDbText")
(cons 10 pt_ins)
(cons 40 (getvar "TEXTSIZE"))
(cons 1 (strcat "E" (itoa count)))
(cons 50 (angle '(0 0 0) (getvar "UCSXDIR")))
'(41 . 1.0)
'(51 . 0.0)
(cons 7 (getvar "TEXTSTYLE"))
'(71 . 0)
'(72 . 1)
(cons 11 pt_ins)
(assoc 210 dxf_ent)
'(100 . "AcDbText")
'(73 . 2)
)
)
)
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point (trans (getvar "VIEWCTR") 1 0))
0.0
(strcat app_txt "Εολ = " (rtos cum_area 2 2) " sq.m")
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color)
;(list 1 (getvar "TEXTSIZE") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 250)
(list 1 (getvar "TEXTSIZE") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 0 0)
)
(setq
ent_text (entlast)
dxf_ent (entget ent_text)
dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent)
dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent)
)
(entmod dxf_ent)
(while (and (setq key (grread T 4 0)) (/= (car key) 3))
(cond
((eq (car key) 5)
(setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent))
(entmod dxf_ent)
)
)
)
(setvar "TEXTSIZE" old_textsize)
)
(T (sssetfirst nil nil) (princ "\nFunction canceled"))
)
)
(T (princ "\nSelected items are invalid"))
)
(princ)
;layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
(*error* "")
)
