多段线距离编号统计（第二版）

newer · 发表于 2018-8-2 23:59:12

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

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

x

本帖最后由 newer 于 2018-8-3 00:08 编辑

(defun c:XDTB_POLYSUMDIS (/ ang blk dir dis e i
key len ml p p1 pnt prefix
scl ss str vertices x len w
)
(defun _callback (key)
(cond
((= key "D")
(if (setq
len (getreal (xdrx_prompt "\n引线长度<" #dog-len ">:" t))
)
(setq #dog-len len)
)
)
((= key "S")
(if (setq len
(getreal (xdrx_prompt "\n基线水平长度<" #dog-len1 ">:" t)
)
)
(setq #dog-len1 len)
)
)
((= key "H")
(if (setq len
(getreal (xdrx_prompt "\n文字高度<" #dog-txtheight ">:" t)
)
)
(setq #dog-txtheight len)
)
)
((= key "I")
(if (/= (setq len (getstring
(xdrx_prompt "\n编号前缀<" #dog-prefix ">:" t)
)
)
""
)
(setq #dog-prefix len)
)
)
)
(_prompt)
)
(defun _prompt ()
(xdrx_prompt
"\n当前设置：编号前缀(" #dog-prefix
") 字高(" #dog-txtheight ") / 引线长度("
#dog-len ") / 水平段长度(" #dog-len1
")"
)
)
(defun _makeMleader (e p str)
(if (not (setq blk (xdrx_object_get "block" "_dotblank")))
(setq blk (xdrx_document_makeablock "_dotblank"))
)
(setq dir (xdrx_curve_getfirstderiv e p)
ang (xdrx_vector_angle dir)
ang (xd::ucs:angle)
p1 (polar p (+ ang (/ pi 4.0)) #dog-len)
)
(setq ml (xdrx_mleader_make
p
p1
str
(* #dog-txtheight (xd::var:getratio))
)
)
(xdrx_mtext_make
'(0 0 0)
str
100.0
(* #dog-txtheight (xd::var:getratio))
)
(setq scl (xd::var:getratio))
(xdrx_setpropertyvalue
ml
"mtext"
(entlast)
"dogleglength"
(* #dog-len1 scl)
"scale"
(xd::var:getscaleratio)
"landinggap"
(* (/ #dog-txtheight 2.0) scl)
"arrowsize"
(* (/ #dog-txtheight 1.0) scl)
"ArrowSymbolId"
blk
"textattachmenttype"
6
) ;(xdrx_entity_delete (entlast))
)
(defun _dim (e)
(setq vertices (xdrx_getpropertyvalue e "vertices"))
(setq i -1)
(xd::text:init 1)
(xd::dim:init)
(setq lst nil)
(repeat (length vertices)
(setq pnt (nth (setq i (1+ i)) vertices)
dis (if (and (> i 0) (equal pnt (car vertices)))
(xdrx_getpropertyvalue e "length")
(xdrx_curve_getdistatpoint e pnt)
)
prefix (xdrx_string_format "%s%d" #dog-prefix (1+ i))
len (- dis
(if (= i 0)
0.0
(xdrx_curve_getdistatpoint e (nth (1- i) vertices))
)
)
len (xdrx_string_format "%.1f" len)
dis (xdrx_string_format "%.1f" dis)
str (strcat "\\pxqc;" prefix "\\P\\pq*;" len "\\P\\pq*;" dis)
lst (cons (list (1+ i) prefix len dis) lst)
)
(_makeMleader e pnt str)
(if (and (> i 0) (equal pnt (car vertices) 1e-5))
(xdrx_setpropertyvalue (entlast) "Quadrant" 2)
)
)
(if (setq pt (getpoint "\n表格插入点<退出>:"))
(progn (setq lst (reverse lst))
(setq lst (cons (list "多段线顶点距离编号统计表" nil nil nil)
(cons (list "顶点" "编号" "本段长度" "距离") lst)
)
)
(setq w (* (xd::var:getratio) #dog-txtheight))
(xd::table:makefromlist lst pt w (/ w 2.0))
)
)
(princ)
)
(xd::doc:checkacadversion '> "17.0" "")
(xdrx_begin)
(xdrx_initssget
"\n选取要标注的多段线[编号前缀(I)/字高(H)/引线长度(D)/水平长度(S)]<退出>:"
"H I D S"
""
"_callback"
)
(xdrx_initget "H I D S")
(if (not #dog-len)
(setq #dog-len 10.0)
)
(if (not #dog-len1)
(setq #dog-len1 2.0)
)
(if (not #dog-prefix)
(setq #dog-prefix "A")
)
(if (not #dog-txtheight)
(setq #dog-txtheight 3.5)
)
(_prompt)
(if (setq ss (xdrx_ssget '((0 . "LWPOLYLINE"))))
(progn
(mapcar '(lambda (x) (_dim x)) (xdrx_pickset->ents ss))
)
)
(xdrx_end)
(princ)
)

(defun c:XDTB_POLYSUMDIS (/        ang   blk   dir          dis        e     i 
                          key        len   ml    p          p1        pnt   prefix 
                          scl        ss    str   vertices        x     len w 
                         ) 
  (defun _callback (key) 
    (cond 
      ((= key "D") 
       (if (setq 
             len (getreal (xdrx_prompt "\n引线长度<" #dog-len ">:" t)) 
           ) 
         (setq #dog-len len) 
       ) 
      ) 
      ((= key "S") 
       (if (setq len 
                  (getreal (xdrx_prompt "\n基线水平长度<" #dog-len1 ">:" t) 
                  ) 
           ) 
         (setq #dog-len1 len) 
       ) 
      ) 
      ((= key "H") 
       (if (setq len 
                  (getreal (xdrx_prompt "\n文字高度<" #dog-txtheight ">:" t) 
                  ) 
           ) 
         (setq #dog-txtheight len) 
       ) 
      ) 
      ((= key "I") 
       (if (/= (setq len (getstring 
                           (xdrx_prompt "\n编号前缀<" #dog-prefix ">:" t) 
                         ) 
               ) 
               "" 
           ) 
         (setq #dog-prefix len) 
       ) 
      ) 
    ) 
    (_prompt) 
  ) 
  (defun _prompt () 
    (xdrx_prompt 
      "\n当前设置：编号前缀("                      #dog-prefix 
      ") 字高("                  #dog-txtheight      ") / 引线长度(" 
      #dog-len                  ") / 水平段长度("   #dog-len1 
      ")" 
     ) 
  ) 
  (defun _makeMleader (e p str) 
    (if        (not (setq blk (xdrx_object_get "block" "_dotblank"))) 
      (setq blk (xdrx_document_makeablock "_dotblank")) 
    ) 
    (setq dir (xdrx_curve_getfirstderiv e p) 
          ang (xdrx_vector_angle dir) 
          ang (xd::ucs:angle) 
          p1  (polar p (+ ang (/ pi 4.0)) #dog-len) 
    ) 
    (setq ml (xdrx_mleader_make 
               p 
               p1 
               str 
               (* #dog-txtheight (xd::var:getratio)) 
             ) 
    ) 
    (xdrx_mtext_make 
      '(0 0 0) 
      str 
      100.0 
      (* #dog-txtheight (xd::var:getratio)) 
    ) 
    (setq scl (xd::var:getratio)) 
    (xdrx_setpropertyvalue 
      ml 
      "mtext" 
      (entlast) 
      "dogleglength" 
      (* #dog-len1 scl) 
      "scale" 
      (xd::var:getscaleratio) 
      "landinggap" 
      (* (/ #dog-txtheight 2.0) scl) 
      "arrowsize" 
      (* (/ #dog-txtheight 1.0) scl) 
      "ArrowSymbolId" 
      blk 
      "textattachmenttype" 
      6 
    )                                        ;(xdrx_entity_delete (entlast)) 
  ) 
  (defun _dim (e) 
    (setq vertices (xdrx_getpropertyvalue e "vertices")) 
    (setq i -1) 
    (xd::text:init 1) 
    (xd::dim:init) 
    (setq lst nil) 
    (repeat (length vertices) 
      (setq pnt           (nth (setq i (1+ i)) vertices) 
            dis           (if (and (> i 0) (equal pnt (car vertices))) 
                     (xdrx_getpropertyvalue e "length") 
                     (xdrx_curve_getdistatpoint e pnt) 
                   ) 
            prefix (xdrx_string_format "%s%d" #dog-prefix (1+ i)) 
            len           (- dis 
                      (if (= i 0) 
                        0.0 
                        (xdrx_curve_getdistatpoint e (nth (1- i) vertices)) 
                      ) 
                   ) 
            len           (xdrx_string_format "%.1f" len) 
            dis           (xdrx_string_format "%.1f" dis) 
            str           (strcat "\\pxqc;" prefix "\\P\\pq*;" len "\\P\\pq*;" dis) 
            lst           (cons (list (1+ i) prefix len dis) lst) 
      ) 
      (_makeMleader e pnt str) 
      (if (and (> i 0) (equal pnt (car vertices) 1e-5)) 
        (xdrx_setpropertyvalue (entlast) "Quadrant" 2) 
      ) 
    ) 
    (if        (setq pt (getpoint "\n表格插入点<退出>:")) 
      (progn (setq lst (reverse lst)) 
             (setq lst (cons (list "多段线顶点距离编号统计表" nil nil nil) 
                             (cons (list "顶 点" "编 号" "本段长度" "距 离") lst) 
                       ) 
             ) 
             (setq w (* (xd::var:getratio) #dog-txtheight)) 
             (xd::table:makefromlist lst pt w (/ w 2.0)) 
      ) 
    ) 
    (princ) 
  ) 
  (xd::doc:checkacadversion '> "17.0" "") 
  (xdrx_begin) 
  (xdrx_initssget 
    "\n选取要标注的多段线[编号前缀(I)/字高(H)/引线长度(D)/水平长度(S)]<退出>:" 
    "H I D S" 
    "" 
    "_callback" 
  ) 
  (xdrx_initget "H I D S") 
  (if (not #dog-len) 
    (setq #dog-len 10.0) 
  ) 
  (if (not #dog-len1) 
    (setq #dog-len1 2.0) 
  ) 
  (if (not #dog-prefix) 
    (setq #dog-prefix "A") 
  ) 
  (if (not #dog-txtheight) 
    (setq #dog-txtheight 3.5) 
  ) 
  (_prompt) 
  (if (setq ss (xdrx_ssget '((0 . "LWPOLYLINE")))) 
    (progn 
      (mapcar '(lambda (x) (_dim x)) (xdrx_pickset->ents ss)) 
    ) 
  ) 
  (xdrx_end) 
  (princ) 
)

zhangfaren · 发表于 2018-8-3 08:24:41

这个太厉害了，谢谢N版！

zhangfaren · 发表于 2018-8-3 08:30:56

本帖最后由 zhangfaren 于 2018-8-3 08:34 编辑

报告N版，刚刚试用了一下，发现多段线编号貌似都是用字母A来编号的，能不能改成以数字顺序从小到大的方式来编号，比如按照A、B、C。。。的顺序。
TIM截图20180803082819.png

qxwangtao · 发表于 2018-8-3 08:58:17

感谢分享，很不错

marting · 发表于 2018-8-3 09:32:11

zhangfaren 发表于 2018-8-3 08:30
报告N版，刚刚试用了一下，发现多段线编号貌似都是用字母A来编号的，能不能改成以数字顺序从小到大的方式来 ...

运行时候，看命令行提示，输入I，改前缀

yangjian001 · 发表于 2018-8-3 09:39:47

不错感谢分享

t666666 · 发表于 2018-8-3 09:49:49

感谢楼主的分享！

zhangfaren · 发表于 2018-8-3 10:31:56

marting 发表于 2018-8-3 09:32
运行时候，看命令行提示，输入I，改前缀

您说的这个我看到了，每根多段线单独统计的时候可以这样子，多根一起批量统计的时候，貌似就不行了！

coverne · 发表于 2018-8-3 10:39:01

感谢分享，很不错

栋梁 · 发表于 2018-8-3 21:29:07

果断收藏牛人，谢谢分享

xoyo88 · 发表于 2019-5-6 23:15:23

多段线距离编号统计

香远益清 · 发表于 2019-11-25 15:21:24

还有一个把坐标生成统计表格的，二者结合起来就更强大了，感谢分享。

香远益清 · 发表于 2019-11-25 15:26:23

提示错误：Application Error: 0 :- no function definition: xdrx_mleader_make; 错误:
*error* 函数中出错ADS 请求错误“

香远益清 · 发表于 2019-11-25 15:34:52

在CAD2014上测试成功，若程序增加小数位数的选择就更好了

武林高高手 · 发表于 2019-11-27 11:03:46

感谢楼主分享！！！

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

[多段线] 多段线距离编号统计（第二版）

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

点评