GS工具箱，快速拉线标注，简单、实用、源码

雨的节奏

1. (defun c:DDF (/ minsize pt1 pt2 ss intlist x y lds olden pts1 pts2 n ens code i ptx endata)
   
2. (if ddf_old_minsize (setq  minsize ddf_old_minsize))
   
3. 
   
4. (while (progn (initget  "S")  (setq pt1 (getpoint "\n指定标注起始方向 \n输入S可以设置过滤尺寸")))
   
5. (while (= "S" pt1)
   
6.        (if (null ddf_old_minsize)
   
7.            (setq minsize (getdist "\n请输入过滤尺寸,默认为【5mm】"))
   
8.            (setq minsize (getdist (strcat "\n请输入过滤尺寸,上次输入为【" (rtos ddf_old_minsize 2 2) "mm】"))))
   
9.         (if (null minsize) (setq minsize 5))
   
10.         (setq ddf_old_minsize minsize)
    
11.         (initget  "S")
    
12.         (setq pt1 (getpoint "\n指定标注起始方向 \n输入S可以设置过滤尺寸"))
    
13. );end while
    
14. 
    
15. (if (null minsize) (setq minsize 5))
    
16. (setq ddf_old_minsize minsize)
    
17. (setq pt2 (getpoint pt1 "\n指定标注方向"))
    
18. (if (setq ss (ssget "F" (list pt1 pt2) '((0 . "*E,CIRCLE,ARC")(6 . "BYLAYER"))))
    
19. (progn
    
20. (setq intlist () endata (ssnamex ss))
    
21. (foreach x endata (foreach y (cdddr x) (setq intlist (cons (cadr y) intlist))))
    
22. ;;点要排序一下才行,按从开始点的距离来排序
    
23. 
    
24. (setq lds (+ 10 (distance pt1 pt2)))
    
25. (setq intlist (vl-remove-if-not '(lambda (x) (<= (distance x pt1) lds)) intlist))
    
26. (setq intlist  (vl-sort  intlist   '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
    
27. ;;这里开始写标注程序
    
28.    (setq olden (entlast) ss (ssadd))
    
29.      (setq n 0)
    
30.      (repeat (- (length intlist) 1)
    
31.              (setq pts1 (nth n intlist)
    
32.                    pts2 (nth (1+ n) intlist))
    
33.              (if (> (distance pts1 pts2) minsize) (ddf_entmakedim pts1 pts2))
    
34.              (setq n (1+ n))
    
35.       );end repeat
    
36. (while (setq ens (entnext olden)) (setq ss (ssadd ens ss) olden ens))
    
37.   ;;下面开始来移动
    
38. 
    
39. (while (and
    
40.         (setq code (grread T 8))
    
41.         (/= 11 (car code))
    
42.         (/= 25 (car code))
    
43.         (/= 3 (car code))
    
44.         (= 5 (car code)))
    
45.         (redraw)
    
46.         (setq ptx (cadr code))
    
47.         (setq i 0)
    
48.         (repeat (sslength ss)
    
49.                  (setq endata (entget (ssname ss i)))
    
50.                  (entmod (subst (cons 10 ptx) (assoc 10 endata) endata ))
    
51.        (setq i (1+ i))
    
52.    ); end repeat
    
53. );end while
    
54. ));end if
    
55. );end while
    
56. (princ "\n标注完成")
    
57. (prin1)
    
58. );end
    
59. 
    
60. 
    
61. 
    
62. (defun ddf_entmakedim (pt1 pt2 /)
    
63. (cond
    
64.   ((or (equal 0 (angle pt1 pt2) 0.001) (equal pi (angle pt1 pt2) 0.001))
    
65.           (entmake
    
66.           (list
    
67.          '(0 . "DIMENSION")
    
68.          '(100 . "AcDbEntity")
    
69.          '(100 . "AcDbDimension")
    
70.         (cons 10 pt1)
    
71.         '(70 . 32) '(1 . "")
    
72.         '(100 . "AcDbAlignedDimension")
    
73.         (cons 13 pt1) (cons 14 pt2)
    
74.        '(100 . "AcDbRotatedDimension")
    
75.     )
    
76.     )
    
77.   )
    
78. ((or (equal (/ pi 2) (angle pt1 pt2) 0.001) (equal (* pi 1.5) (angle pt1 pt2) 0.001))
    
79.    (entmake
    
80.       (list
    
81.       '(0 . "DIMENSION")
    
82.       '(100 . "AcDbEntity")
    
83.       '(100 . "AcDbDimension")
    
84.       (cons 10 pt1)
    
85.       '(70 . 33) '(1 . "")
    
86.      '(100 . "AcDbAlignedDimension")
    
87.     (cons 13 pt1) (cons 14 pt2)
    
88.     )
    
89.   )
    
90.   )
    
91. ((and (null (equal 0 (angle pt1 pt2) 0.001)) (null (equal (/ pi 2) (angle pt1 pt2) 0.001)))
    
92.    (entmake
    
93.       (list
    
94.       '(0 . "DIMENSION")
    
95.       '(100 . "AcDbEntity")
    
96.       '(100 . "AcDbDimension")
    
97.       (cons 10 pt1)
    
98.       '(70 . 33) '(1 . "")
    
99.      '(100 . "AcDbAlignedDimension")
    
100.     (cons 13 pt1) (cons 14 pt2)
     
101.     )
     
102.   )
     
103. )
     
104. );end cond
     
105. );end
     
106. (prin1)
     
107. 
     
108. 
     
109. 
     
110. 
     
111. 
     
112. 
     
113. 
     
114. 
     
115. 
     
116. 
     
117. 
     
118. 
     
119. 
     
120. 
     
121. 
     
122. 
     
123. 
     
124. 
     
125.       

(defun c:DDF (/ minsize pt1 pt2 ss intlist x y lds olden pts1 pts2 n ens code i ptx endata)<br /> (if ddf_old_minsize (setq  minsize ddf_old_minsize))<br /> <br /> (while (progn (initget  "S")  (setq pt1 (getpoint "\n指定标注起始方向 \n输入S可以设置过滤尺寸")))<br /> (while (= "S" pt1)<br />        (if (null ddf_old_minsize) <br />            (setq minsize (getdist "\n请输入过滤尺寸,默认为【5mm】"))<br />            (setq minsize (getdist (strcat "\n请输入过滤尺寸,上次输入为【" (rtos ddf_old_minsize 2 2) "mm】"))))<br />         (if (null minsize) (setq minsize 5))<br />         (setq ddf_old_minsize minsize)<br />         (initget  "S")<br />         (setq pt1 (getpoint "\n指定标注起始方向 \n输入S可以设置过滤尺寸"))<br /> );end while <br /> <br /> (if (null minsize) (setq minsize 5))<br /> (setq ddf_old_minsize minsize)<br /> (setq pt2 (getpoint pt1 "\n指定标注方向"))<br /> (if (setq ss (ssget "F" (list pt1 pt2) '((0 . "*E,CIRCLE,ARC")(6 . "BYLAYER"))))<br /> (progn<br /> (setq intlist () endata (ssnamex ss))<br /> (foreach x endata (foreach y (cdddr x) (setq intlist (cons (cadr y) intlist))))<br /> ;;点要排序一下才行,按从开始点的距离来排序<br /> <br /> (setq lds (+ 10 (distance pt1 pt2)))<br /> (setq intlist (vl-remove-if-not '(lambda (x) (<= (distance x pt1) lds)) intlist))<br /> (setq intlist  (vl-sort  intlist   '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))<br /> ;;这里开始写标注程序<br />    (setq olden (entlast) ss (ssadd))<br />      (setq n 0)<br />      (repeat (- (length intlist) 1)<br />              (setq pts1 (nth n intlist)<br />                    pts2 (nth (1+ n) intlist))<br />              (if (> (distance pts1 pts2) minsize) (ddf_entmakedim pts1 pts2))<br />              (setq n (1+ n))<br />       );end repeat<br /> (while (setq ens (entnext olden)) (setq ss (ssadd ens ss) olden ens))<br />   ;;下面开始来移动<br /> <br /> (while (and<br />         (setq code (grread T 8))<br />         (/= 11 (car code))<br />         (/= 25 (car code))<br />         (/= 3 (car code))<br />         (= 5 (car code)))<br />         (redraw)<br />         (setq ptx (cadr code))<br />         (setq i 0)<br />         (repeat (sslength ss)<br />                  (setq endata (entget (ssname ss i)))<br />                  (entmod (subst (cons 10 ptx) (assoc 10 endata) endata ))<br />        (setq i (1+ i))<br />    ); end repeat<br /> );end while<br /> ));end if<br /> );end while<br /> (princ "\n标注完成")<br /> (prin1)<br /> );end<br /> <br /> <br /> <br /> (defun ddf_entmakedim (pt1 pt2 /)<br /> (cond<br />   ((or (equal 0 (angle pt1 pt2) 0.001) (equal pi (angle pt1 pt2) 0.001))<br />           (entmake <br />           (list<br />          '(0 . "DIMENSION")<br />          '(100 . "AcDbEntity")<br />          '(100 . "AcDbDimension") <br />         (cons 10 pt1) <br />         '(70 . 32) '(1 . "") <br />         '(100 . "AcDbAlignedDimension")<br />         (cons 13 pt1) (cons 14 pt2)<br />        '(100 . "AcDbRotatedDimension")<br />     )<br />     )<br />   )<br /> ((or (equal (/ pi 2) (angle pt1 pt2) 0.001) (equal (* pi 1.5) (angle pt1 pt2) 0.001))<br />    (entmake <br />       (list <br />       '(0 . "DIMENSION") <br />       '(100 . "AcDbEntity") <br />       '(100 . "AcDbDimension") <br />       (cons 10 pt1) <br />       '(70 . 33) '(1 . "") <br />      '(100 . "AcDbAlignedDimension")<br />     (cons 13 pt1) (cons 14 pt2)<br />     )<br />   )<br />   )<br /> ((and (null (equal 0 (angle pt1 pt2) 0.001)) (null (equal (/ pi 2) (angle pt1 pt2) 0.001)))<br />    (entmake <br />       (list <br />       '(0 . "DIMENSION") <br />       '(100 . "AcDbEntity") <br />       '(100 . "AcDbDimension") <br />       (cons 10 pt1) <br />       '(70 . 33) '(1 . "") <br />      '(100 . "AcDbAlignedDimension")<br />     (cons 13 pt1) (cons 14 pt2)<br />     )<br />   )<br /> )<br /> );end cond<br /> );end<br /> (prin1)<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> <br />       

liuxiooang

不会用，脑壳痛。

liuties

感谢楼主分享   很实用

cghdy

cghdy 发表于 2019-11-12 12:50
大兄弟。能不能整个完整版的，有错误用不得

http://bbs.mjtd.com/forum.php?mo ... D%CF%DF%B1%EA%D7%A2

KO你

这个和CAD默认的qdim快速标注有什么不同吗，是否交点标注。怎么不见运行命令

纵横八方

能斜拉吗，迷你的可以斜拉

664571221

怎么用不起来大兄弟？？

BaoWSE

非常好！收藏学习！

纵横八方

大胸弟，的程序bug太多

pengfei2010

哈哈不错，思路很好，我做的虽然比你这个强大，但是你这个思路非常简洁，思路值得借鉴

664571221

pengfei2010 发表于 2019-9-27 08:21
哈哈不错，思路很好，我做的虽然比你这个强大，但是你这个思路非常简洁，思路值得借鉴

能发一个吗大兄弟？？？

bbswen

不错，谢谢楼主

iszc

收藏学习！！！

xiangganglv

会技术，点赞！会分享，点赞！说话还好听，更要点赞。