表面积 - 修改 LISP
我是LISP新手，我找到了LISP的讨论专区，这地方太好了。我需要它将区域写入表的第三列，而不是第二列。我修改了一些参数以创建表的第三列和第一行，但下面的有点问题。
另外，我希望在圆的质心中插入数字，但是功能要是可选的。
文字的高度应为0.3，圆的半径应为0 0.25。
我在开始时定义了样式，但高度不起作用。
这是 LISP：
(defun c:Recap nil (AreaLabel t));; Areas to Table;start of sectin added to define text style(entmakex'( (0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "room_Style") (70 . 0) (40 . 0.3);vla-object x) 'area) (not (eq "HATCH" (cdr (assoc 0 (entget x))))) (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x)) ) ) entsel '("Pick") ) ) (progn (initget "Object") (setq p1 (getpoint "\nPick Area : "))) ) (cond ( (null p1) (vla-delete tb) ) ( (eq "Pick" p1) (setq om nil) t ) ( (eq "Object" p1) (setq om t) ) ( (eq 'ENAME (type p1)) (setq tx (cons (_text acspc (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1)))) (strcat pf (itoa *al:num) sf) ts ucsxang ) tx ) ) (vla-insertrows tb (setq n 2) th 1) (vla-settext tb n 2 ;changed here from 1 to 2 (if fd (strcat "%%" ) (strcat ap (rtos (* cf (vla-get-area p1)) 2) as) ) ) (vla-settext tb n 0 (if fd (strcat "%%" ) (strcat pf (itoa *al:num) sf) ) ) nil ) ( (vl-consp p1) (setq el (entlast)) (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "") (if (not (equal el (setq el (entlast)))) (progn (setq tx (cons (_text acspc (_centroid acspc (list (vlax-ename->vla-object el))) (strcat pf (itoa *al:num) sf) ts ucsxang ) tx ) ) (vla-insertrows tb (setq n 2) th 1) (vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as)) (vla-settext tb n 0 (if fd (strcat "%%" ) (strcat pf (itoa *al:num) sf) ) ) (redraw el 3) nil ) (vla-delete tb) ) ) ) ) ) (not (vlax-erased-p tb)) ) ( (and (setq tb (_Select "\nSelect Table to Add to: " '(lambda ( x ) (eq "ACAD_TABLE" (cdr (assoc 0 (entget x))))) entsel nil ) ) (< 1 (vla-get-columns (setq tb (vlax-ename->vla-object tb)))) ) (setq n (1- (vla-get-rows tb)) *al:num (1- *al:num)) ) ) (progn (while (if om (setq p1 (_Select (strcat "\nSelect Object [" (if tx "Undo/" "") "Pick] : ") '(lambda ( x ) (and (vlax-property-available-p (vlax-ename->vla-object x) 'area) (not (eq "HATCH" (cdr (assoc 0 (entget x))))) (or (eq "REGION" (cdr (assoc 0 (entget x)))) (vlax-curve-isclosed x)) ) ) entsel (list (if tx "Undo Pick" "Pick")) ) ) (progn (initget (if tx "Undo Object" "Object")) (setq p1 (getpoint (strcat "\nPick Area [" (if tx "Undo/" "") "Object] : "))) ) ) (cond ( (and tx (eq "Undo" p1)) (if el (progn (entdel el) (setq el nil))) (vla-deleterows tb n 1) (vla-delete (car tx)) (setq n (1- n) tx (cdr tx) *al:num (1- *al:num)) ) ( (eq "Undo" p1) (princ "\n--> Nothing to Undo.") ) ( (eq "Object" p1) (if el (progn (entdel el) (setq el nil))) (setq om t) ) ( (eq "Pick" p1) (setq om nil) ) ( (and om (eq 'ENAME (type p1))) (setq tx (cons (_text acspc (_centroid acspc (list (setq p1 (vlax-ename->vla-object p1)))) (strcat pf (itoa (setq *al:num (1+ *al:num))) sf) ts ucsxang ) tx ) ) (vla-insertrows tb (setq n (1+ n)) th 1) (vla-settext tb n 1 (if fd (strcat "%%" ) (strcat ap (rtos (* cf (vla-get-area p1)) 2) as) ) ) (vla-settext tb n 0 (if fd (strcat "%%" ) (strcat pf (itoa *al:num) sf) ) ) ) ( (vl-consp p1) (if el (progn (entdel el) (setq el nil))) (setq el (entlast)) (vl-cmdf "_.-boundary" "_A" "_I" "_N" "" "_O" "_P" "" "_non" p1 "") (if (not (equal el (setq el (entlast)))) (progn (setq tx (cons (_text acspc (_centroid acspc (list (vlax-ename->vla-object el))) (strcat pf (itoa (setq *al:num (1+ *al:num))) sf) ts ucsxang ) tx ) ) (vla-insertrows tb (setq n (1+ n)) th 1) (vla-settext tb n 1 (strcat ap (rtos (* cf (vlax-curve-getarea el)) 2) as)) (vla-settext tb n 0 (if fd (strcat "%%" ) (strcat pf (itoa *al:num) sf) ) ) (redraw el 3) ) (princ "\n--> Error Retrieving Area.") ) ) ) ) (if el (progn (entdel el) (setq el nil))) ) ) ) )(setenv "LMAC_AreaLabel" (if om "1" "0"))(setvar 'CMDECHO cm)(_EndUndo acdoc)(princ));;------------------------------------------------------------;;;; End of File ;;;;------------------------------------------------------------;; 另外，非常重要，我需要它在点之后将区域四舍五入到 1 个数字。
例如从 830.1755 到 830.2。
谢谢！
页:
[1]