地块（多边形）分析统计

newer · 发表于 2025-1-10 10:27:24

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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)
)

(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) 
)

dnbc · 发表于 2025-1-13 08:19:31

学习学习！

账号		自动登录	找回密码
密码			立即注册

[每日一码] 地块（多边形）分析统计

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

浏览过的版块