求高手修改多段线自动编号标注长度程序

jack11280

在本论坛收集了一个多段线自动编号标注长度想请高手改一下
原程序对只能标在图纸上希望能有大大帮忙改一下让也可以顺便输出至Excel
在此贴出程序原文希望能有人帮忙


;;;BY X_S_S_1
(vl-load-com)
(defun c:la (/
                ss
                qz
                lst
                length_lst
                en
                pt_lst
                curve-obj
                dist
                s_lst
                n
                pt
                tl
               )
  (defun x_ssn (ss / n lst)
    (repeat (setq N (sslength ss))
      (setq LST (cons (ssname SS (setq N (1- N))) LST))
    )
  )
  (defun emk_t (layer pt1 pt2 text ang n72 n73 h /)
    (entmake (list '(0 . "text")
                   '(100 . "AcDbEntity")
                   (cons 8 layer)
                   '(100 . "AcDbText")
                   (cons 10 pt1)
                   (cons 1 text)
                   (cons 40 h)
                   '(41 . 0.75)
                   '(7 . "standard")
                   (cons 72 n72)
                   (cons 11 pt2)
                   (cons 50 ang)
                   (cons 73 n73)
             ) ;_ 结束list
    ) ;_ 结束entmake
  ) ;_ 结束defun
  (SETQ SS (SSGET '((0 . "*LINE,CIRCLE,ARC,ELLIPSE"))))
  (setq qz (getstring "\n前缀:"))
  (setq lst (x_ssn ss))
  (setq        length_lst
         (mapcar '(lambda (en)
                    (vlax-curve-getDistAtParam
                      en
                      (vlax-curve-getEndParam en)
                    )
                  )
                 lst
         )
  )
  (setq
    pt_lst (mapcar '(lambda (curve-obj dist)
                      (vlax-curve-getPointAtDist curve-obj (/ dist 2))
                    )
                   lst
                   length_lst
           )
  )
  (setq s_lst nil)
  (repeat (setq n (length length_lst))
    (setq s_lst        (cons (strcat qz
                              (itoa n)
                              "="
                              (rtos (nth (1- n) length_lst) 2 2)
                      )
                      s_lst
                )
    )
    (setq n (1- n))
  )
  (mapcar '(lambda (pt tl) (emk_t "0" pt pt tl 0 1 0 250))  ;此句可以将(emk_t "0" pt pt tl 0 1 0 250))做变量(250改文字大小)
          pt_lst
          s_lst
  )
)

jack11280

再頂一下

梦里水香

好程序，帮忙顶一个，字体要是可以自定义大小就好了，要是字与线对齐就更好了。。

jack11280

我也在等高手完善這程序

jack11280

我再頂一直頂

bai2000

能自定义高度并写在图上，更好

jack11280

我再頂一直頂

香田里浪人

编程精神可嘉，使用价值不大，已经有人编程面积周长输出excel

jkop

很方便的线段编码程序，希望有大神出手，协助修改。