wangsr 发表于 2024-1-31 08:23:57

谢谢分享。

359321852 发表于 2024-1-31 08:38:06

本帖最后由 359321852 于 2024-1-31 08:41 编辑

飞雪神光 发表于 2024-1-29 11:06
水平有限 就改成这样了
谢谢你的帮助，
在你的基础上也做了一些修改，增加了获取文字高度，和设置
(defun c:tt (/ ss ent lis)
;多段线每段线中心标注本段线长
    (setq ss (ssget ":P:E" '((0 . "LWPOLYLINE"))))
    (setq h1 (getvar "TEXTSIZE"));获取文本高度
    (setq h (getreal (strcat "\n请键入文字高度<" (rtos h1 2 2) ">:")))
(if (null h)
    (setq h h1)
)
(setvar"textsize" h);设置文本高度
    (setq ent (ssname ss 0))
    (mapcar
      '(lambda (x)
         (setq pt (cadr x))
         (setq an (last x))(print an)
         (setq an (if (>= (* pi 1.5) an (* pi 0.5)) (- an pi) an))
         (setq pt (polar pt (+ an (* pi 0.5)) h));偏离一个文字的高度距离
         (entmake
               (list '(0 . "TEXT") '(72 . 1) '(73 . 2)
                   (cons 1 (car x))
                   (cons 10 pt)
                   (cons 11 pt)
                   (cons 40 h)
                   (cons 50 an)
               )
         )
       )
      (mapcar
            '(lambda (x)
               (list
                   (rtos (distance (car x) (cadr x)) 2 2)
                   (mapcar '* '(0.5 0.5) (mapcar '+ (car x) (cadr x)))
                   (- (rem (+ (angle (car x) (cadr x)) (* 0.25 pi)) pi) (* 0.25 pi))
               )
         )
            (if (vlax-curve-isClosed ent)
                (mapcar 'list
                  (setq lis (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= 10 (car x)))(entget ent))))
                  (append (cdr lis) (list (car lis)))
                )
                (reverse
                  (cdr
                        (reverse
                            (mapcar 'list
                              (setq lis (mapcar 'cdr (vl-remove-if-not '(lambda (x)(= 10 (car x)))(entget ent))))
                              (append (cdr lis) (list (car lis)))
                            )
                        )
                  )
                )
            )
      )
    )
    (princ)
)

yefei812678 发表于 2024-2-1 10:33:01

好牛逼的插件

azaz042 发表于 2024-2-2 10:13:10

vitalgg 发表于 2024-1-30 12:25
源码：
https://gitee.com/atlisp/packages/blob/main/at-curve/at-curve.lsp

請問各位大神安裝後指令是什麼 ?
謝謝

azaz042 发表于 2024-2-2 10:22:27

359321852 发表于 2024-1-31 08:38
谢谢你的帮助，
在你的基础上也做了一些修改，增加了获取文字高度，和设置

弧長好是不正確
:Q-

vitalgg 发表于 2024-2-2 10:46:39

azaz042 发表于 2024-2-2 10:13
請問各位大神安裝後指令是什麼 ?
謝謝

没有给具体的指令。
安装核心管理后，可以直接运行函数 (at-curve:per-length) 或者从菜单或命令面板点击。
也可以自己设置指令
(defun c:你想要的指令 ()(at-curve:per-length))

azaz042 发表于 2024-2-2 10:56:47

vitalgg 发表于 2024-2-2 10:46
没有给具体的指令。
安装核心管理后，可以直接运行函数 (at-curve:per-length) 或者从菜单或命令面板点 ...

:handshake:handshake

atone 发表于 2024-2-12 13:30:43

厉害厉害，学习中
页: 1 [2]
查看完整版本: CAD 多段线文字标注插件