明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4317|回复: 22

[源码] 标注对齐源码

[复制链接]
发表于 2019-7-12 11:15:43 | 显示全部楼层 |阅读模式


  1. (defun c:dag (/ ss ptx i endata pt13 pt14 ang vlen)
  2. (princ "\n选择要对齐的标注")
  3. (setq ss (ssget '((0 . "DIMENSION"))))
  4. ;;需要计算一下哪种标注最多
  5. ;;排除少量的,用最多的那种
  6. (while (= (car (grread 1)) 5)
  7.          (setq ptx (cadr (grread 1)))
  8.          (setq i 0)
  9.          (repeat (sslength ss)
  10.                  (setq endata (entget (ssname ss i)))
  11.                  (entmod (subst (cons 10 ptx) (assoc 10 endata) endata ))
  12.        (setq i (1+ i))
  13.    ); end repeat
  14. );end while
  15. ;;下面来指定引线起点
  16. (setq ptx (getpoint "\n指定标注引线起点") i 0)
  17. (repeat (sslength ss)
  18.       (setq endata (entget (ssname ss i)))

  19.        (setq pt13 (cdr (assoc 13 endata))
  20.        pt14 (cdr (assoc 14 endata)))      
  21.       (if (= 33 (cdr (assoc 70 endata))) (setq ang (angle pt13 pt14)) (setq  ang  (cdr (assoc 50 endata))))
  22.       (entmake (list '(0 . "LINE") (cons 10 ptx) (cons 11 (polar ptx ang 100))))
  23.       (setq vlen (vlax-ename->vla-object (entlast)))
  24.       ;;求出跟线最近的点
  25.        (setq  endata (subst (cons 13  (vlax-curve-getclosestpointto vlen pt13 T)) (assoc 13 endata) endata)
  26.               endata (subst (cons 14  (vlax-curve-getclosestpointto vlen pt14 T)) (assoc 14 endata) endata))      
  27.       (vla-erase vlen)
  28.      (entmod endata)
  29.      (setq i (1+ i))
  30.    
  31. );end repeat
  32.      
  33. )


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

试用了标注对齐,少了捕捉不好定位,标注的文字移过位的,文字不能跟着尺寸线位移,等待完善。  发表于 2019-7-12 15:40

评分

参与人数 1明经币 +1 收起 理由
USER2128 + 1 赞一个!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2019-8-16 20:44:46 | 显示全部楼层
本帖最后由 forever111 于 2019-8-16 21:19 编辑

使用时跟演示的好像不太一样,所以简单修改了一下,望指教。
(defun c:dag (/ ss ptx i endata pt13 pt14 ang vlen)
(princ "\n选择要对齐的标注")
(setq ss (ssget '((0 . "DIMENSION"))))
;;需要计算一下哪种标注最多
;;排除少量的,用最多的那种
(while (= (car(setq poi(grread 1))) 5)
         (setq ptx (cadr poi))
      (setq i 0)
      (repeat (sslength ss)
        (setq endata (entget (ssname ss i)))
        (entmod (subst (cons 10 ptx) (assoc 10 endata) endata ))
        (setq i (1+ i))
        ))
;;下面来指定引线起点
(setq ptx (getpoint "\n指定标注引线起点"))
  (setq i 0)
(repeat (sslength ss)
      (setq endata (entget (ssname ss i)))
       (setq pt13 (cdr (assoc 13 endata))
             pt14 (cdr (assoc 14 endata)))      
      (if (= 33 (cdr (assoc 70 endata))) (setq ang (angle pt13 pt14)) (setq  ang  (cdr (assoc 50 endata))))
      (entmake (list '(0 . "LINE") (cons 10 ptx) (cons 11 (polar ptx ang 100))))
      (setq vlen (vlax-ename->vla-object (entlast)))
      ;;求出跟线最近的点
       (setq  endata (subst (cons 13  (vlax-curve-getclosestpointto vlen pt13 T)) (assoc 13 endata) endata)
              endata (subst (cons 14  (vlax-curve-getclosestpointto vlen pt14 T)) (assoc 14 endata) endata))      
      (vla-erase vlen)
     (entmod endata)
     (setq i (1+ i))
   
);end repeat
     
)

我用的是2019版本的。。
发表于 2019-8-1 23:49:41 | 显示全部楼层
本帖最后由 1028695446 于 2019-8-1 23:57 编辑
雨的节奏 发表于 2019-7-12 11:20
难的地方应该在这里、、、

试了下,角度标注对齐需完善

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2019-7-13 13:17:03 | 显示全部楼层
有个bag:当只挪一个标注的时候提示“ 错误: DXF 组不正确: (10 . 32)”。
 楼主| 发表于 2019-7-12 11:20:44 | 显示全部楼层


难的地方应该在这里、、、

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2019-7-12 12:15:46 | 显示全部楼层
谢谢!  雨的节奏  分享程序!!!!
发表于 2019-7-12 12:24:18 | 显示全部楼层
比我写的好  我写了好长才写出来
发表于 2019-7-12 13:27:03 | 显示全部楼层
程序很实用,多谢楼主分享
 楼主| 发表于 2019-7-12 21:01:46 | 显示全部楼层

源码都 有了,需要别的细节可以自己修改
发表于 2019-7-13 11:29:03 | 显示全部楼层
谢谢楼主分享好程序
发表于 2019-7-13 13:12:28 | 显示全部楼层
贱人工具箱也有,不能动态,但是好像更稳定。
发表于 2019-7-16 07:43:51 | 显示全部楼层

程序很实用,多谢楼主分享
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 01:27 , Processed in 0.183567 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表