多段线顶点坐标列表统计（支持凸度和边长）

Lispboy · 发表于 2017-8-13 00:43:38

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

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

×

本帖最后由 newer 于 2018-12-25 15:36 编辑

可选 Z 坐标是否列出。

多段线上编号标注待完成。

[sell]

(defun c:XDTB_PLSegList (/ #xd_table_res_z _lengths _format _writebulges _mergecell bulge bulges
verts i j c val lens lst r gl g
)
(defun _lengths ()
(setq g (xdge::constructor e)
gl (xdge::getpropertyvalue g "getcurvelist")
)
(setq lens (mapcar '(lambda (x) (xdge::getpropertyvalue x "length"))
gl
)
)
(xdge::free g gl)
lens
)
(defun _writebulges (tb)
(setq rows (xdrx_table_numrows tb))
(setq i 3
j 0
)
(while (< i (1- rows))
(setq bulge (_format (nth j bulges) 4))
(if (= bulge "0.0")
(setq bulge "")
)
(xdrx_setpropertyvalue
tb
"textstring"
(list (list i 4 bulge) (list i 5 (_format (nth j lens) #xd_table_txt_bits)))
"textheight"
(list (list i 4 #xd_table_txt_height)
(list i 5 #xd_table_txt_height)
)
)
(setq j (1+ j)
i (+ i 2)
)
)
)
(defun _format (str bit)
(if (equal str 0.0 1e-3)
"0.0"
(rtos str 2 bit)
)
)
(defun _mergecell (tb startCol endCol startRow)
(setq rows (xdrx_table_numrows tb))
(setq c startCol)
(while (<= startCol c endCol)
(setq r startRow)
(while (< r (1- rows))
(xdrx_table_mergecells tb r (1+ r) c c)
(setq r (+ 2 r))
)
(setq c (1+ c))
)
)
(xdrx_begin)
(xdrx_sysvar_push '("dimzin" 0))
(if (= 1 (xdrx_yesorno "\n保留Z坐标" 0))
(setq #xd_table_res_z t)
)
(if (not #xd_table_txt_height)
(setq #xd_table_txt_height 3.5)
)
(if (setq val (getreal (xdrx_prompt "\n字高<" #xd_table_txt_height ">:" t)
)
)
(setq #xd_table_txt_height val)
)
(if (not #xd_table_txt_bits)
(setq #xd_table_txt_bits 1)
)
(if (setq val (getint
(xdrx_prompt "\n边长小数位<" #xd_table_txt_bits ">:" t)
)
)
(setq #xd_table_txt_bits val)
)
(if (setq e (car (xdrx_entsel
"\n拾取一个多段线<退出>:"
'((0 . "LWPOLYLINE"))
)
)
)
(progn (setq verts (xdrx_getpropertyvalue e "vertices" "bulges")
lens (_lengths)
bulges (cadr verts)
verts (car verts)
)
(setq lst (mapcar '(lambda (x)
(list (_format (car x) 4)
(_format (cadr x) 4)
(_format (caddr x) 4)
""
""
)
)
verts
)
)
(setq lst (xd::table:celltile
'("序号" "X坐标" "Y坐标" "Z坐标" "凸度" "边长")
1
lst
)
)
(setq i 0
lst (mapcar '(lambda (x)
(if (= i 0)
(progn (setq i (1+ i)) (list x))
(list x x)
)
)
lst
)
lst (cons (list "界址点坐标表" nil nil nil nil nil)
(apply 'append lst)
)
)
(if (setq pt (getpoint "\n表格插入点<退出>:"))
(progn (xd::text:init 1)
(setq tb (xd::table:makefromlist lst pt #xd_table_txt_height 0.0))
(xd::table:begin tb)
(_mergecell tb 0 3 2)
(_mergecell tb 4 5 3)
(_writebulges tb)
(if (not #xd_table_res_z)
(xdrx_table_deletecolumns tb 3 1)
)
(xdrx_table_setrowheight tb 0 (* 2.0 #xd_table_txt_height))
(xdrx_table_setrowheight tb 1 (* 2.0 #xd_table_txt_height))
(xdrx_setpropertyvalue
tb
"HorzCellMargin"
(/ #xd_table_txt_height 2.0)
"autosize"
t
)
(xd::table:end tb)
)
)
)
)
(xdrx_sysvar_pop)
(xdrx_end)
(princ)
)

(defun c:XDTB_PLSegList (/ #xd_table_res_z _lengths _format _writebulges _mergecell bulge bulges 
                         verts i j c val lens lst r gl g 
                        ) 
  (defun _lengths () 
    (setq g  (xdge::constructor e) 
          gl (xdge::getpropertyvalue g "getcurvelist") 
    ) 
    (setq lens (mapcar '(lambda (x) (xdge::getpropertyvalue x "length")) 
                       gl 
               ) 
    ) 
    (xdge::free g gl) 
    lens 
  ) 
  (defun _writebulges (tb) 
    (setq rows (xdrx_table_numrows tb)) 
    (setq i 3 
          j 0 
    ) 
    (while (
      (setq bulge (_format (nth j bulges) 4)) 
      (if (= bulge "0.0") 
        (setq bulge "") 
      ) 
      (xdrx_setpropertyvalue 
        tb 
        "textstring" 
        (list (list i 4 bulge) (list i 5 (_format (nth j lens) #xd_table_txt_bits))) 
        "textheight" 
        (list (list i 4 #xd_table_txt_height) 
              (list i 5 #xd_table_txt_height) 
        ) 
      ) 
      (setq j (1+ j) 
            i (+ i 2) 
      ) 
    ) 
  ) 
  (defun _format (str bit) 
    (if (equal str 0.0 1e-3) 
      "0.0" 
      (rtos str 2 bit) 
    ) 
  ) 
  (defun _mergecell (tb startCol endCol startRow) 
    (setq rows (xdrx_table_numrows tb)) 
    (setq c startCol) 
    (while (<= startCol c endCol) 
      (setq r startRow) 
      (while (< r (1- rows)) 
        (xdrx_table_mergecells tb r (1+ r) c c) 
        (setq r (+ 2 r)) 
      ) 
      (setq c (1+ c)) 
    ) 
  ) 
  (xdrx_begin) 
  (xdrx_sysvar_push '("dimzin" 0)) 
  (if (= 1 (xdrx_yesorno "\n保留Z坐标" 0)) 
    (setq #xd_table_res_z t) 
  ) 
  (if (not #xd_table_txt_height) 
    (setq #xd_table_txt_height 3.5) 
  ) 
  (if (setq val (getreal (xdrx_prompt "\n字高<" #xd_table_txt_height ">:" t) 
                ) 
      ) 
    (setq #xd_table_txt_height val) 
  ) 
  (if (not #xd_table_txt_bits) 
    (setq #xd_table_txt_bits 1) 
  ) 
  (if (setq val (getint 
                  (xdrx_prompt "\n边长小数位<" #xd_table_txt_bits ">:" t) 
                ) 
      ) 
    (setq #xd_table_txt_bits val) 
  ) 
  (if (setq e (car (xdrx_entsel 
                     "\n拾取一个多段线<退出>:" 
                     '((0 . "LWPOLYLINE")) 
                   ) 
              ) 
      ) 
    (progn (setq verts  (xdrx_getpropertyvalue e "vertices" "bulges") 
                 lens   (_lengths) 
                 bulges (cadr verts) 
                 verts  (car verts) 
           ) 
           (setq lst (mapcar '(lambda (x) 
                                (list (_format (car x) 4) 
                                      (_format (cadr x) 4) 
                                      (_format (caddr x) 4) 
                                      "" 
                                      "" 
                                ) 
                              ) 
                             verts 
                     ) 
           ) 
           (setq lst (xd::table:celltile 
                       '("序 号" "X坐标" "Y坐标" "Z坐标" "凸 度" "边 长") 
                       1 
                       lst 
                     ) 
           ) 
           (setq i   0 
                 lst (mapcar '(lambda (x) 
                                (if (= i 0) 
                                  (progn (setq i (1+ i)) (list x)) 
                                  (list x x) 
                                ) 
                              ) 
                             lst 
                     ) 
                 lst (cons (list "界址点坐标表" nil nil nil nil nil) 
                           (apply 'append lst) 
                     ) 
           ) 
           (if (setq pt (getpoint "\n表格插入点<退出>:")) 
             (progn (xd::text:init 1) 
                    (setq tb (xd::table:makefromlist lst pt #xd_table_txt_height 0.0)) 
                    (xd::table:begin tb) 
                    (_mergecell tb 0 3 2) 
                    (_mergecell tb 4 5 3) 
                    (_writebulges tb) 
                    (if (not #xd_table_res_z) 
                      (xdrx_table_deletecolumns tb 3 1) 
                    ) 
                    (xdrx_table_setrowheight tb 0 (* 2.0 #xd_table_txt_height)) 
                    (xdrx_table_setrowheight tb 1 (* 2.0 #xd_table_txt_height)) 
                    (xdrx_setpropertyvalue 
                      tb 
                      "HorzCellMargin" 
                      (/ #xd_table_txt_height 2.0) 
                      "autosize" 
                      t 
                    ) 
                    (xd::table:end tb) 
             ) 
           ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_end) 
  (princ) 
)

[/sell]

yangjian001 · 发表于 2017-8-13 08:29:19

多段线上编号标注非常期待

yoyoho · 发表于 2017-8-13 14:35:31

回覆学习，谢谢分享！！！！

lijunfa12345 · 发表于 2017-8-20 20:54:34

烟花丝雨11 · 发表于 2017-8-21 14:36:53

谢谢分享！！！！

WZY5357 · 发表于 2018-12-1 17:45:13

太好了，谢谢楼主！

xoyo88 · 发表于 2019-5-6 21:20:26

太好了，谢谢楼主

香远益清 · 发表于 2019-11-25 14:18:34

绘制宗地图在没有CASS软件的情况，使用该插件可以快速实现，赞一个

香远益清 · 发表于 2019-11-25 14:30:04

测试不成功，白白损失10个豆，显示“致命错误，无法写入放弃文件（可能磁盘已满）”，点确定后就退出CAD了。

香远益清 · 发表于 2019-11-25 14:41:49

多段线上编号标注非常期待

kyky1002 · 发表于 2020-3-19 21:41:54

这个真是很好用

XIAODONHUANGXUE · 发表于 2020-5-25 11:14:21

感谢分享，

wx_bn5Y8HHA · 发表于 2020-9-18 12:20:19

本帖最后由 wx_bn5Y8HHA 于 2020-9-18 12:21 编辑

是不是可以增加一些信息，这样有助于放样表格制作。当然直接在线段上标注编号那就更完美了。

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

[多段线] 多段线顶点坐标列表统计（支持凸度和边长）

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