修改版-快速拉线标注--带捕捉-免费等高手解决

pengbin

修改版，取消S设置逻辑，增加总尺，但是总标尺有问题，等高手解决，另外想增加一个识别折线忽略折线进行标尺，柜体标尺是没有问题的，测试平台AutoCAD 2007，其他版本也可以试试，适合这2年的全屋定制，命令：DDF

源码：

说明-有问题存在，等高手解决

演示操作

1028695446原版在这里:http://bbs.mjtd.com/forum.php?mod=viewthread&tid=180410&highlight=%BF%EC%CB%D9%C0%AD%CF%DF%B1%EA%D7%A2

修改自 雨的节奏 http://bbs.mjtd.com/thread-180247-1-1.html

花了不少时间修改好了-展示一下

========================================================================

; DDF标注命令 - 修正横向标尺位置，仅显示标尺无文字

(defun c:DDF (/ pt1 pt2 ss intlist lds olden pts1 pts2 n ens code i ptx endata dist

                total-dist total-pt1 total-pt2 dir-ang offset-dist total-dim-obj

                base-dim-pt orig-offset-ang orig-offset-dist)

    ; 配置参数

    (setq filter-sizes (vl-sort '( 0 36 1) '<)

          tolerance 0.01

          offset-dist 120)  ; 固定距离120mm

    ; 获取标注起始点

    (setq pt1 (getpoint "\n指定标注起始点: "))

    (if (null pt1) (progn (princ "\n命令取消") (return)))

    ; 获取标注方向点

    (setq pt2 (getpoint pt1 "\n指定标注方向: "))

    (if (null pt2) (progn (princ "\n命令取消") (return)))

    ; 选择过滤实体

    (if (setq ss (ssget "F" (list pt1 pt2) '((0 . "*E,CIRCLE,ARC")(6 . "BYLAYER"))))

        (progn

            (setq intlist nil

                  endata (ssnamex ss))

            ; 提取并净化交点列表（去重）

            (foreach x endata

                (foreach y (cdddr x)

                    (setq pt (cadr y))

                    (if (not (vl-some '(lambda (p) (equal p pt tolerance)) intlist))

                        (setq intlist (cons pt intlist))

                    )

                )

            )

            ; 过滤并排序点

            (setq lds (+ 10 (distance pt1 pt2))

                  intlist (vl-remove-if-not

                            '(lambda (x) (<= (distance x pt1) lds))

                            intlist)

                  intlist (vl-sort

                            intlist

                            '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))

            (if (< (length intlist) 2)

                (progn (princ "\n有效交点不足，无法标注") (return))

            )

            ; 创建普通标注（无文字）

            (setq olden (entlast)

                  ss (ssadd))

            (setq n 0)

            (repeat (- (length intlist) 1)

                (setq pts1 (nth n intlist)

                      pts2 (nth (1+ n) intlist)

                      dist (distance pts1 pts2))

                ; 过滤标注逻辑

                (if (and (> dist tolerance)

                         (not (vl-some

                                '(lambda (s)

                                    (and (>= dist (- s tolerance))

                                         (<= dist (+ s tolerance))))

                                filter-sizes)))

                    (ddf_entmakedim pts1 pts2)  ; 调用无文字标注函数

                )

                (setq n (1+ n))

            )

            ; 收集普通标注并记录基准点

            (while (setq ens (entnext olden))

                (setq ss (ssadd ens ss)

                      olden ens)

            )

            (if (> (sslength ss) 0)

                (setq base-dim-pt (cdr (assoc 10 (entget (ssname ss 0)))))

                (setq base-dim-pt (midpoint pt1 pt2))  ;  fallback基准点

            )

            ; -------------------- 总长标注逻辑 --------------------

            ; 计算总长参数

            (setq total-pt1 (car intlist)

                  total-pt2 (last intlist)

                  total-dist (distance total-pt1 total-pt2)

                  dir-ang (angle total-pt1 total-pt2))  ; 标注方向角度

            ; 修正横向标注偏移方向（解决上移问题）

            ; 横向（水平）标注时强制向下偏移，其他方向按原逻辑

            (setq orig-offset-ang

                (if (or (equal dir-ang 0 0.001) (equal dir-ang pi 0.001))  ; 水平方向判断

                    (+ dir-ang (/ pi 1.5))  ; 横向向下偏移（避免上移）

                    (+ dir-ang (/ pi 2))    ; 其他方向正常外侧偏移

                )

                orig-offset-dist offset-dist

            )

            ; 初始位置：基于原标注基准点偏移120mm

            (setq total-dim-pt (polar base-dim-pt orig-offset-ang orig-offset-dist))

            ; 创建总长标注（无任何文字，仅标尺）

            (entmake

                (list

                    '(0 . "DIMENSION")

                    '(100 . "AcDbEntity")

                    '(100 . "AcDbDimension")

                    (cons 10 total-dim-pt)

                    '(70 . 32)

                    '(1 . "")  ; 空文字

                    '(100 . "AcDbAlignedDimension")

                    (cons 13 total-pt1)

                    (cons 14 total-pt2)

                    '(100 . "AcDbRotatedDimension")

                )

            )

            (setq total-dim-obj (entlast))

            ; ------------------------------------------------------

            ; 拖动逻辑：保持总长与原标注120mm距离

            (while (and (setq code (grread T 8))

                        (/= 11 (car code))

                        (/= 25 (car code))

                        (/= 3 (car code))

                        (= 5 (car code)))

                (redraw)

                (setq ptx (cadr code)

                      i 0)

                ; 1. 移动原标注到新位置

                (repeat (sslength ss)

                    (setq endata (entget (ssname ss i)))

                    (entmod (subst (cons 10 ptx) (assoc 10 endata) endata))

                    (setq i (1+ i))

                )

                ; 2. 计算总长标注新位置（保持偏移关系）

                (setq new-total-pt (polar ptx orig-offset-ang orig-offset-dist)

                      total-endata (entget total-dim-obj))

                ; 3. 移动总长标注

                (entmod (subst (cons 10 new-total-pt) (assoc 10 total-endata) total-endata))

            )

        )

        (princ "\n未找到符合条件的实体")

    )

    (princ "\n标注完成（横向标尺已修正，无文字）")

    (prin1)

)

; 辅助函数：计算两点中点

(defun midpoint (p1 p2)

    (list (/ (+ (car p1) (car p2)) 2.0)

          (/ (+ (cadr p1) (cadr p2)) 2.0)

          0.0)

)

; 创建标注实体的函数（无文字版本）

(defun ddf_entmakedim (pt1 pt2 / ang)

    (setq ang (angle pt1 pt2))

    (cond

        ((or (equal 0 ang 0.001) (equal pi ang 0.001))  ; 水平

            (entmake

                (list

                    '(0 . "DIMENSION")

                    '(100 . "AcDbEntity")

                    '(100 . "AcDbDimension")

                    (cons 10 pt1)

                    '(70 . 32)

                    '(1 . "")  ; 空文字

                    '(100 . "AcDbAlignedDimension")

                    (cons 13 pt1)

                    (cons 14 pt2)

                    '(100 . "AcDbRotatedDimension")

                )

            )

        )

        ((or (equal (/ pi 2) ang 0.001) (equal (* pi 1.5) ang 0.001))  ; 垂直

            (entmake

                (list

                    '(0 . "DIMENSION")

                    '(100 . "AcDbEntity")

                    '(100 . "AcDbDimension")

                    (cons 10 pt1)

                    '(70 . 33)

                    '(1 . "")  ; 空文字

                    '(100 . "AcDbAlignedDimension")

                    (cons 13 pt1)

                    (cons 14 pt2)

                )

            )

        )

        (T  ; 其他角度

            (entmake

                (list

                    '(0 . "DIMENSION")

                    '(100 . "AcDbEntity")

                    '(100 . "AcDbDimension")

                    (cons 10 pt1)

                    '(70 . 33)

                    '(1 . "")  ; 空文字

                    '(100 . "AcDbAlignedDimension")

                    (cons 13 pt1)

                    (cons 14 pt2)

                )

            )

        )

    )

)

(princ "\nDDF标注命令加载完成，输入DDF启动（横向修正版）")

(prin1)

jkop

很强大的批量标注，可以适用于家具，室内设计  建筑设计标注，方便施工使用，感谢分享!

dingtiedt

楼主有心了！
在下也改进了拉线标注，初衷只是想用在布局空间，(在布局里标注的网友不怎么多，布局里标注会因为线性测量比例的问题而出错...)，功能：仅使用一个标注样式--拖动定点--定的第三点为尺寸偏移点(而不是尺寸线的位置点)--增加总标--自动识别视口比例--自动赋于线性测量比例和全局标注比例--尺寸避让等等；
后来越改进适用范围就越多一些，不局限于布局空间，扩展到布局里的模型空间(浮动空间)，实现在模型空间、布局空间、布局里的模型空间都能标；
随着不断的测试，发现只能在WCS坐标系下标注，感觉不爽。又扩展了在UCS坐标系下也能标注，关于坐标的空间转换，一个头两个大，只学了前辈们的皮毛。

尺寸标注的角度，学院长用了50组码，省去分析各种角度条件。

测试中，也遇到跟楼主一样的问题，交点有时会莫名的分段，是不是ssget "F"获取交点本身就有待完善；
有时还有尺寸没有拖动效果。

22693766

似乎, 还得继续改改...

pengbin

dingtiedt 发表于 2025-9-8 22:31
楼主有心了！
在下也改进了拉线标注，初衷只是想用在布局空间，(在布局里标注的网友不怎么多，布局 ...

(setq filter-sizes (vl-sort '( 0 36 1) '<)        这段修改你需要过滤的尺寸，这里比如是0，36，1，颜色过滤没写在里面，可以自己增加过滤颜色的语句，另外就是捕捉方向有问题，还有总尺寸是不能拉伸变尺，我在模型空间测试的，布局里没有试过，先把这几个问题解决掉就会很好用加油
&#65532; 管理
点评回复 编辑支持 反对使用道具 评分
  123&#65532; / 3 页下一页返回列表&#65532;&#65532;
&#65532;
高

pengbin

22693766 发表于 2025-9-15 23:18
似乎, 还得继续改改...

是的是的，这个版本需要优化，源码嘛，只是给一个你想要的开头，最后需要达到一个什么效果，需要自己去添加修改

丶俗人

我可以把我修改的发你这里不~

尘缘一生

一直想回复这个拉线标注，就是不知说个明白：

拉线标注啊，确实不错，重要的是它里面的两个标注函数。而不是拉线本身。
为什么要拉线？这是画图的习惯吗？应该是选择线类实体吗，不拉线，这不是常规的画法，
如果大家要这么画图，拉线？这个操作是你特有的特例，对不对，
应该不拉线，选实体，这个解决了，才是最终归途。。。。
对了，我开发的 SLdesign （三领设计）早已解决了这个问题。

qifeifei

太酷了 很好用

不一样地设计

感谢楼主分享！！

张向华

多谢分享下来看看

专用车研发

感谢楼主分享！！

qifeifei

又升级了 感谢分享

pengbin

qifeifei 发表于 2025-9-7 17:31
又升级了 感谢分享

你研究一下，PL画的折线和直线画的斜线能不能过滤掉

qd001

花一个币下载试一试

丶俗人

过滤一下颜色就好了呀.

pengbin

丶俗人 发表于 2025-9-7 20:45
过滤一下颜色就好了呀.

嗯，是的，已经弄好了