Page 2 of 2
Re: Trapezoid area lisp
Posted: Sat Dec 24, 2022 2:15 am
by QuanNguyen
SPirou4D wrote: ↑Fri Dec 23, 2022 4:53 am
BUT I can't remove to this problem :
Code: Select all
Run-time error 87:
error: too few arguments
nil
Hi,
Please replace the line:
(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "n" "n" "n")
by
(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "n" "n" )
and also IntelliCAD doesn't support some properties in the lines:
Code: Select all
(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 0 0)
)
Re: Trapezoid area lisp
Posted: Sat Dec 24, 2022 3:13 am
by SPirou4D
Thanks you so QuanNguyen, you really follow me....
I tested your idea and now the popup to select new layer is deselected now! Thks
But I have yet one :
Run-time error 87:
error: too few arguments
nil
I changed this code:
Code: Select all
(mapcar
'(lambda (pr val)
(vlax-put-property nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'Width 'color 'DrawingDirection 'EntityName 'EntityType 'StyleName 'Layer 'Linetype 'Lineweight 'Rotation 'BackgroundMask 'TrueColor 'Annotative)
(list 1 (getvar "TEXTSIZE") "" 18 5 "Mtext" 23 (getvar "TEXTSTYLE") (getvar "CLAYER") (getvar "LINETYPE") (getvar "LINEWEIGHT") 0.0 "No" 18 "No")
)
with the list of all properties: (vlax-dump-object nw_obj )
but no changes.
Re: Trapezoid area lisp
Posted: Sat Dec 24, 2022 3:32 am
by SPirou4D
BUT I can't remove this "too few arguments!" problem .
Certainly in this code :
Code: Select all
(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)
)
For me, Lisp is more complicated than perl or python....
Re: Trapezoid area lisp
Posted: Sun Dec 25, 2022 8:03 pm
by QuanNguyen
Yes, you need to check if the dxf_data existing the 90 and 63 dxf codes before trying to replace them.
I bypass some lines (set/change properties) and it works now.
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 diag1 diag2 diag max_diag pt4 surf1 surf2 nw_obj ent_text key)
(command "_layer" "_m" "AREA CALC" "_c" "7" "" "")
(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "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)
)
)
(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)
; triangles
(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 3)) (atof (rtos d1 2 3)) 0.5)
cum_area (atof (rtos (+ surf cum_area) 2 3))
)
(strcat
"E" (itoa (setq count (1+ count))) " = "
"1/2 x "
(rtos max_d 2 2)
" x (ht "
(rtos d1 2 2)
") = "
(rtos surf 2 2) " m2\\P"
)
)
; equilateral
(if (and
(equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)))
(equal (distance (car ptlst) (caddr ptlst)) (distance (cadr ptlst) (cadddr ptlst))))
(progn
(setq
d1 (atof (rtos (distance (car ptlst) (cadr ptlst)) 2 3))
d2 (atof (rtos (distance (cadr ptlst) (caddr ptlst)) 2 3))
surf (atof (rtos (* d1 d2) 2 3))
cum_area (atof (rtos (+ surf cum_area) 2 3))
)
(strcat
"E" (itoa (setq count (1+ count))) " = "
(rtos d1 2 2)
" x "
(rtos d2 2 2)
" = "
(rtos surf 2 2)
" m2\\P"
)
)
; trapezoidals
(progn
(setq
diag1 (distance (car ptlst) (caddr ptlst))
diag2 (distance (cadr ptlst) (cadddr ptlst))
diag (list diag1 diag2)
max_diag (apply 'max diag)
pt1 (if(> diag1 diag2) (car ptlst) (cadr ptlst))
pt2 (if(> diag1 diag2) (caddr ptlst) (cadddr ptlst))
pt3 (if(> diag1 diag2) (cadr ptlst) (caddr ptlst))
pt4 (if(> diag1 diag2) (cadddr ptlst) (car ptlst))
d1
(distance
pt3
(inters
pt1
pt2
pt3
(polar pt3 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
nil
)
)
d2
(distance
pt4
(inters
pt1
pt2
pt4
(polar pt4 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
nil
)
)
ht (atof (rtos (+ d1 d2) 2 3))
surf (* (atof(rtos max_diag 2 3)) (atof (rtos ht 2 3)) 0.5)
cum_area (atof (rtos (+ surf cum_area) 2 3))
)
(strcat
"E" (itoa (setq count (1+ count))) " = "
"1/2 x "
(rtos max_diag 2 2)
" x (ht "
(rtos ht 2 2)
") = "
(rtos surf 2 2) " m2\\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 "TOTAL = " (rtos cum_area 2 2) " m2")
)
)
;(setq entvla (vlax-ename->vla-object (car (entsel "\nChoix de l'entité\n"))))
;(vlax-dump-object entvla)
;(mapcar
; '(lambda (pr val)
; (vlax-put nw_obj pr val)
; )
; (list 'AttachmentPoint 'color 'DrawingDirection 'Height 'Layer 'Linetype 'LinetypeScale 'Lineweight 'StyleName 'Rotation 'Visible)
; (list 1 18 1 (getvar "TEXTSIZE") (getvar "CLAYER") (getvar "LINETYPE") 1 (getvar "LINEWEIGHT") (getvar "TEXTSTYLE") 0.0 -1)
;)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'StyleName 'Layer 'Rotation )
(list 1 (getvar "TEXTSIZE") (getvar "TEXTSTYLE") (getvar "CLAYER") 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)(entupd ent_text)
)
)
)
(setvar "TEXTSIZE" old_textsize)
)
(T (sssetfirst nil nil) (princ "\nFunction canceled because no calculation"))
)
)
(T (princ "\nSelected items are invalid"))
)
(princ)
;return on the layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
(*error* "Modify your code !")
)
Re: Trapezoid area lisp
Posted: Mon Dec 26, 2022 3:44 am
by SPirou4D
Haaaaa YES that's work now: you can choose where you put the text! Very good QuanNguyen! Congratulation.
BUT I can't thank for his question the "ProM" who isn't a well brought up person!
Re: Trapezoid area lisp
Posted: Mon Dec 26, 2022 10:48 am
by SPirou4D
Here is the last release of this script with the choice of calculation of Trapezoids :
Code: Select all
(vl-load-com)
(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 diag1 diag2 diag max_diag pt4 surf1 surf2 nw_obj ent_text key)
(command "_layer" "_m" "AREA CALC" "_c" "7" "" "")
(command "_.-style" "AREA CALC" "arial.ttf" 2.5 "1" "0" "N" "N")
(while (null (setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . ">") (90 . 2) (-4 . "<") (90 . 5) (-4 . "AND>"))))))
(setq trap (eq (getkword "\n Add trapezoids's calculations [Yes/No]? <Yes>: ") "No"))
(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)
)
(initget "Yes No")
(if (and trap (eq n 4))
(if (not (and
(equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)))
(equal (distance (car ptlst) (caddr ptlst)) (distance (cadr ptlst) (cadddr ptlst))))
)
(ssdel ent js)
)
)
)
(cond
((and js (> (sslength js) 0))
(sssetfirst nil js)
(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)
; triangles
(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 4)) (atof (rtos d1 2 4)) 0.5)
cum_area (atof (rtos (+ surf cum_area) 2 4))
)
(strcat
"E" (itoa (setq count (1+ count))) " = "
"1/2 x "
(rtos max_d 2 2)
" x (ht "
(rtos d1 2 2)
") = "
(rtos surf 2 2) " m2\\P"
)
)
; equilateral
(if (and
(equal (distance (car ptlst) (cadr ptlst)) (distance (caddr ptlst) (cadddr ptlst)))
(equal (distance (car ptlst) (caddr ptlst)) (distance (cadr ptlst) (cadddr ptlst))))
(progn
(setq
d1 (atof (rtos (distance (car ptlst) (cadr ptlst)) 2 4))
d2 (atof (rtos (distance (cadr ptlst) (caddr ptlst)) 2 4))
surf (atof (rtos (* d1 d2) 2 4))
cum_area (atof (rtos (+ surf cum_area) 2 4))
)
(strcat
"E" (itoa (setq count (1+ count))) " = "
(rtos d1 2 2)
" x "
(rtos d2 2 2)
" = "
(rtos surf 2 2)
" m2\\P"
)
)
; trapezoidals
(progn
(setq
diag1 (distance (car ptlst) (caddr ptlst))
diag2 (distance (cadr ptlst) (cadddr ptlst))
diag (list diag1 diag2)
max_diag (apply 'max diag)
pt1 (if(> diag1 diag2) (car ptlst) (cadr ptlst))
pt2 (if(> diag1 diag2) (caddr ptlst) (cadddr ptlst))
pt3 (if(> diag1 diag2) (cadr ptlst) (caddr ptlst))
pt4 (if(> diag1 diag2) (cadddr ptlst) (car ptlst))
d1
(distance
pt3
(inters
pt1
pt2
pt3
(polar pt3 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
nil
)
)
d2
(distance
pt4
(inters
pt1
pt2
pt4
(polar pt4 (+ (angle pt1 pt2) (* pi 0.5)) (distance pt1 pt2))
nil
)
)
ht (atof (rtos (+ d1 d2) 2 4))
surf (* (atof(rtos max_diag 2 4)) (atof (rtos ht 2 4)) 0.5)
cum_area (atof (rtos (+ surf cum_area) 2 4))
)
(strcat
"E" (itoa (setq count (1+ count))) " = "
"1/2 x "
(rtos max_diag 2 2)
" x (ht "
(rtos ht 2 2)
") = "
(rtos surf 2 2) " m2\\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 "TOTAL = " (rtos cum_area 2 2) " m2")
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'StyleName 'Layer 'Rotation )
(list 1 (getvar "TEXTSIZE") (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 )
)
(setq
ent_text (entlast)
dxf_ent (entget ent_text)
)
(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)
(entupd ent_text)
)
)
)
(setvar "TEXTSIZE" old_textsize)
)
(T (princ "\nSelected items are invalid"))
)
(princ)
;return on the layer 0
(mapcar 'setvar '("clayer" "cecolor" "celtype" "celweight") (list "0" "BYLAYER" "BYLAYER" -1))
(*error* "")
)
EDIT 1 : Corrected with more precise rounded result !
- image_2022-12-26_175020289.png (34.85 KiB) Viewed 15377 times