地块（多边形）分析统计
https://www.cadtutor.net/forum/topic/76630-lisp-to-select-multiple-polygons-and-assign-area-text-to-them-already-have-lisp-that-do-it-for-one-polygon/#replyForm
(defun c:xdtb_pl-analyze (/ #area #centroid #length #numverts #xd-var-global-text-height end-row height i lst minl mtxt n
pt pts ss start-row str tbl temp tlst tlst1 verts w x
)
(xd::doc:getdouble (xdrx-string-multilanguage "\n文字高度：" "\nText Height:") "#xd-var-global-text-height"
(setq height (xd::doc:getpickboxheight))
)
(if (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n选择封闭的多段线<退出>:"
"\nSelect Closed Polyline<Exit>:"
) '((0 . "*POLYLINE") (-4 . "&=")
(70 . 1)
)
)
)
(progn
(xdrx-begin)
(setq lst (xdrx-entity-getproperty ss "boundingbox"))
(setq lst (mapcar
'(lambda (x)
(setq temp (car x))
(min
(distance (car temp) (cadr temp))
(distance (cadr temp) (caddr temp))
)
)
lst
)
)
(setq minl (apply
'min
lst
)
)
(xdrx-document-setprec (/ minl 2.0))
(setq lst (xd::pickset:tablesort ss 0 3 '< '>)
i 0
verts nil
tlst nil
)
(mapcar
'(lambda (x)
(xdrx-getpropertyvalue x "centroid" "area" "length" "numverts")
(setq verts (cons (list (setq i (1+ i))
#numverts
) verts
)
)
(setq mtxt (xdrx-mtext-make #centroid (setq str (xdrx-string-formatex "%d\nL=%.1f\nS=%.2f" i
#length #area
)
)
1.0 #xd-var-global-text-height
)
)
(xdrx-setpropertyvalue mtxt "attachment" 5)
(setq pts (xdrx-getpropertyvalue x "vertices")
pts (xd::pnts:open pts)
#numverts (length pts))
(foreach n pts
(setq tlst (cons (list i #numverts (rtos #length 2 4) (rtos #area 2 4) (rtos (car n) 2 4)
(rtos (cadr n) 2 4) (rtos (caddr n) 2 4)
) tlst
)
)
)
)
(xd::list:flat lst)
)
(setq tlst (reverse tlst))
(setq tlst (cons (list (xdrx-string-multilanguage "地块统计表" "Plot Statistics Table") nil nil nil nil
nil nil
) (cons (list (xdrx-string-multilanguage "编号" "P&N")
(xdrx-string-multilanguage "顶点数" "N&V")
(xdrx-string-multilanguage "长度" "Length")
(xdrx-string-multilanguage "面积" "Area")
(xdrx-string-multilanguage "X坐标" "X coordinate")
(xdrx-string-multilanguage "Y坐标" "Y coordinate")
(xdrx-string-multilanguage "Z坐标" "Z coordinate")
) tlst
)
)
)
(if (setq pt (getpoint (xdrx-string-multilanguage "\n表格插入点<退出>:" "\nTable Insert Point<Exit>:")))
(progn
(setq w (* (xd::var:getratio) #xd-var-global-text-height))
(xd::table:makefromlist tlst pt w (/ w 2.0))
(setq tbl (entlast))
(setq verts (reverse verts)
start-row 2
)
(foreach n verts
(setq end-row (1- (+ start-row (last n))))
(xdrx_table_MergeCells tbl start-row end-row 0 0)
(xdrx_table_MergeCells tbl start-row end-row 1 1)
(xdrx_table_MergeCells tbl start-row end-row 2 2)
(xdrx_table_MergeCells tbl start-row end-row 3 3)
(setq start-row (1+ end-row))
)
)
)
(xdrx-end)
)
)
(princ)
)
学习学习！{:1_12:}{:1_12:}{:1_12:}
页:
[1]