求助论坛高手帮忙编制一个批量标注CAD断面图超欠挖插件

lizhgang.jin

各位高手，我是搞隧道施工的，做隧道断面图时监理要求我们在图上把超欠挖尺寸标出来，便于查看。我们以前都是一个个标。效率太低了。想请教一下论坛的高手能否帮忙编写一个小工具什么都可以，CAD能加载就行。要求达到的功能就是把实测断面线（多断线）的顶点，到设计开挖线（可能是圆或圆和多断线）间的尺寸，大于设计线加正号，小于设计线加负号。（标注点号最好能设置间隔几点）我发了一个参考图，就是想达到的效果，希望高手不吝时间，帮忙解决一下。谢谢！

dwp@hamco

1. ;文件名：ddd.lsp
   
2. ;;功能说明：标注实际开挖线各点与设计开挖线之间的距离
   
3. ;;;修改时间：2015-01-07
   
4. 
   
5. (vl-load-com)
   
6. (defun c:ddd(/ ss en v-en pc ss1 en1 po-li n p11 pt pt@curve osm)  
   
7.   (setq osm (getvar "osmode"))  
   
8.   (setvar "cmdecho" 0)
   
9.   (setvar "osmode" 0)  
   
10. 
    
11.   (while(progn(prompt "\n请选择设计开挖线：")
    
12.                 (not(setq ss(ssget ":s" '((0 . "CIRCLE,*POLYLINE")))))
    
13.         );end progn
    
14.     (prompt "\n<<<<未选择到正确的对象，请重新选择!>>>>")
    
15.   );end while
    
16. 
    
17.   (setq en(ssname ss 0)
    
18.         v-en(vlax-ename->vla-object en))
    
19.   
    
20.   (setq pc(find-centerpoint en));找设计开挖线的型心
    
21. 
    
22.   (while(progn(prompt "\n请选择实际开挖线：")
    
23.                 (not(setq ss1(ssget ":s" '((0 . "*POLYLINE")))))
    
24.         );end progn
    
25.     (prompt "\n<<<<未选择到正确的对象，请重新选择!>>>>")
    
26.   );end while
    
27. 
    
28.   (setq en1(ssname ss1 0))
    
29.   (setq po-li (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) (entget en1))));取多段线顶点表
    
30. 
    
31.   (initget 6)
    
32.   (setq n(getint "\n请输入实际开挖线上标注间隔数(默认为0)："))
    
33.   (if(null n)(setq n 0))
    
34. 
    
35.   (if(/= n 0)(setq po-li(get-new-point-list po-li n)));end if
    
36. 
    
37.   (foreach pt po-li   
    
38.     (setq pt@curve(vlax-curve-getClosestPointTo v-en pt))
    
39.    
    
40.     (if(> (distance pt pc) (distance pt@curve pc));如果超挖
    
41.       (progn
    
42.       (setq p11(polar pt@curve (angle pt@curve pt) (* 2 (distance pt pt@curve))))
    
43.       (make-dimension pt pt@curve p11 "隧道超挖+")
    
44.       );end progn
    
45.       );end if
    
46. 
    
47.     (if(< (distance pt pc) (distance pt@curve pc));如果欠挖
    
48.       (progn
    
49.       (setq p11(polar pt(angle pt pt@curve ) (* 3 (distance pt pt@curve))))
    
50.       (make-dimension pt@curve pt p11 "隧道欠挖-")
    
51.       );end progn
    
52.       );end if
    
53.       
    
54.     );end foreach
    
55.   
    
56.   (setvar "osmode" osm)
    
57.   (princ)  
    
58.   );end defun
    
59. 
    
60. ;;;sub-routine1
    
61. (defun find-centerpoint(en / po-li n y pc)
    
62.   (setq entda(entget en)
    
63.         ename(cdr(assoc 0 entda)))
    
64.   (if(= ename "CIRCLE")
    
65.     (setq pc(cdr(assoc 10 entda)))
    
66.     (progn
    
67.       (setq po-li (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) entda)))
    
68.       (setq n(length po-li))  
    
69.       (setq y(apply 'mapcar (cons '+ po-li)))
    
70.       (setq pc(mapcar '/ y (list n n n)))
    
71.       );progn
    
72.     );end if
    
73.   );end defun
    
74. 
    
75. ;;;sub-routine2
    
76. (defun make-dimension (p13 p14 p11 dimsty)
    
77.   (entmake (list '(0 . "DIMENSION")
    
78.                  '(100 . "AcDbEntity")
    
79.                  '(100 . "AcDbDimension")                 
    
80.                   (cons 10 p14)
    
81.                   (cons 11 p11)
    
82.                  '(70 . 33)
    
83.                  '(1 . "")
    
84.                   (cons 3 dimsty)
    
85.                  '(100 . "AcDbAlignedDimension")
    
86.                  (cons 13 p13)
    
87.                  (cons 14 p14)
    
88.                  )
    
89.            );endmake  
    
90.   );end defun
    
91. 
    
92. ;;;sub-routine3
    
93. ;;;间隔N个数取点表
    
94. (defun get-new-point-list(li n / s-li i k)
    
95.   (setq s-li nil i 0 k (1+ n))
    
96. 
    
97.   (while(nth i li)
    
98.     (setq s-li(cons (nth i li) s-li))
    
99.     (setq i(+ i k))
    
100.     );end while
     
101.   
     
102.   (reverse s-li)
     
103.   );end defun

;文件名：ddd.lsp<br /> ;;功能说明：标注实际开挖线各点与设计开挖线之间的距离<br /> ;;;修改时间：2015-01-07<br /> <br /> (vl-load-com)<br /> (defun c:ddd(/ ss en v-en pc ss1 en1 po-li n p11 pt pt@curve osm)  <br />   (setq osm (getvar "osmode"))  <br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 0)  <br /> <br />   (while(progn(prompt "\n请选择设计开挖线：")<br />                 (not(setq ss(ssget ":s" '((0 . "CIRCLE,*POLYLINE")))))<br />         );end progn<br />     (prompt "\n<<<<未选择到正确的对象，请重新选择!>>>>")<br />   );end while<br /> <br />   (setq en(ssname ss 0)<br />         v-en(vlax-ename->vla-object en))<br />   <br />   (setq pc(find-centerpoint en));找设计开挖线的型心<br /> <br />   (while(progn(prompt "\n请选择实际开挖线：")<br />                 (not(setq ss1(ssget ":s" '((0 . "*POLYLINE")))))<br />         );end progn<br />     (prompt "\n<<<<未选择到正确的对象，请重新选择!>>>>")<br />   );end while<br /> <br />   (setq en1(ssname ss1 0))<br />   (setq po-li (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) (entget en1))));取多段线顶点表<br /> <br />   (initget 6)<br />   (setq n(getint "\n请输入实际开挖线上标注间隔数(默认为0)："))<br />   (if(null n)(setq n 0))<br /> <br />   (if(/= n 0)(setq po-li(get-new-point-list po-li n)));end if<br /> <br />   (foreach pt po-li    <br />     (setq pt@curve(vlax-curve-getClosestPointTo v-en pt))<br />     <br />     (if(> (distance pt pc) (distance pt@curve pc));如果超挖<br />       (progn<br />       (setq p11(polar pt@curve (angle pt@curve pt) (* 2 (distance pt pt@curve))))<br />       (make-dimension pt pt@curve p11 "隧道超挖+")<br />       );end progn<br />       );end if<br /> <br />     (if(< (distance pt pc) (distance pt@curve pc));如果欠挖<br />       (progn<br />       (setq p11(polar pt(angle pt pt@curve ) (* 3 (distance pt pt@curve))))<br />       (make-dimension pt@curve pt p11 "隧道欠挖-")<br />       );end progn<br />       );end if<br />        <br />     );end foreach<br />   <br />   (setvar "osmode" osm) <br />   (princ)  <br />   );end defun<br /> <br /> ;;;sub-routine1<br /> (defun find-centerpoint(en / po-li n y pc)<br />   (setq entda(entget en)<br />         ename(cdr(assoc 0 entda)))<br />   (if(= ename "CIRCLE")<br />     (setq pc(cdr(assoc 10 entda)))<br />     (progn<br />       (setq po-li (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) entda)))<br />       (setq n(length po-li))  <br />       (setq y(apply 'mapcar (cons '+ po-li)))<br />       (setq pc(mapcar '/ y (list n n n)))<br />       );progn<br />     );end if<br />   );end defun<br /> <br /> ;;;sub-routine2<br /> (defun make-dimension (p13 p14 p11 dimsty)<br />   (entmake (list '(0 . "DIMENSION")<br />                  '(100 . "AcDbEntity")<br />                  '(100 . "AcDbDimension")                 <br />                   (cons 10 p14)<br />                   (cons 11 p11)<br />                  '(70 . 33)<br />                  '(1 . "")<br />                   (cons 3 dimsty)<br />                  '(100 . "AcDbAlignedDimension")<br />                  (cons 13 p13)<br />                  (cons 14 p14)<br />                  )<br />            );endmake  <br />   );end defun<br /> <br /> ;;;sub-routine3<br /> ;;;间隔N个数取点表<br /> (defun get-new-point-list(li n / s-li i k)<br />   (setq s-li nil i 0 k (1+ n))<br /> <br />   (while(nth i li)<br />     (setq s-li(cons (nth i li) s-li))<br />     (setq i(+ i k))<br />     );end while<br />   <br />   (reverse s-li)<br />   );end defun

csharp

实测的点是什么形式？你都在图上画好了？

口味虾

这个mark下，还要加班，回家了写一下。

lizhgang.jin

节过完了，不知兄台弄成了没有，小兄盼望之急。

lizhgang.jin

实测点我都画好了，就是用X,Y数据文件定完基点后用多段线画出，多段线顶点就是各各实测坐标了。

lizhgang.jin

现在就是要标注一下，如果能编出连绘图一起搞的插件那就非常完美了。

zxq0220

怎样标？给个图样或图片。

dwp@hamco

1. ;文件名：dbz.lsp
   
2. ;;功能说明：标注所选点与设计开挖线之间的距离
   
3. ;;;时间：2015-01-06
   
4. 
   
5. (vl-load-com)
   
6. (defun c:dbz(/ ss en v-en pc pt pt@curve osm)  
   
7.   (setq osm (getvar "osmode"))
   
8.   
   
9.   (setvar "cmdecho" 0)
   
10.   (setvar "osmode" 0)  
    
11. 
    
12.   (while(progn(prompt "\n请选择设计开挖线：")
    
13.                 (not(setq ss(ssget ":s" '((0 . "CIRCLE,*POLYLINE,")))))
    
14.         );end progn
    
15.     (prompt "\n<<<<未选择到正确的对象，请重新选择!>>>>")
    
16.   );end while
    
17. 
    
18.   (setq en(ssname ss 0)
    
19.         v-en(vlax-ename->vla-object en))
    
20.   
    
21.   (setq pc(find-centerpoint en)) ;找设计开挖线的型心
    
22. 
    
23.   (setvar "osmode" 59)
    
24. 
    
25.   (setq pt t)
    
26. 
    
27.   (while pt
    
28.     (setq pt(getpoint "\n请在实际开挖线上点选开挖点："))
    
29.    
    
30.     (if pt (progn
    
31.              
    
32.     (setq pt@curve(vlax-curve-getClosestPointTo v-en pt))
    
33.     (if(> (distance pt pc) (distance pt@curve pc));如果超挖
    
34.       (command "-dimstyle" "r" "隧道超挖+"));end if
    
35. 
    
36.     (if(< (distance pt pc) (distance pt@curve pc));如果欠挖
    
37.       (command "-dimstyle" "r" "隧道欠挖-"));end if
    
38.    
    
39.     (make-dimension pt pt@curve)
    
40.     );end progn
    
41.     );end if   
    
42.     );end while  
    
43.   (setvar "osmode" osm)
    
44.   (princ)  
    
45.   );end defun
    
46. 
    
47. ;;;sub-routine1
    
48. (defun find-centerpoint(en / po-li n y pc)
    
49.   (setq entda(entget en)
    
50.         ename(cdr(assoc 0 entda)))
    
51.   (if(= ename "CIRCLE")
    
52.     (setq pc(cdr(assoc 10 entda)))
    
53.     (progn
    
54.       (setq po-li (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) entda)))
    
55.       (setq n(length po-li))  
    
56.       (setq y(apply 'mapcar (cons '+ po-li)))
    
57.       (setq pc(mapcar '/ y (list n n n)))
    
58.       );progn
    
59.     );end if
    
60.   );end defun
    
61. 
    
62. ;;;sub-routine2
    
63. (defun make-dimension (p13 p14)
    
64.   (entmake (list '(0 . "DIMENSION")
    
65.                  '(100 . "AcDbEntity")
    
66.                  '(100 . "AcDbDimension")                 
    
67.                   (cons 10 p14)
    
68.                   (cons 11 (polar p14 (angle p14 p13) (* (distance p14 p13) 2) ))
    
69.                  '(70 . 33)
    
70.                  '(1 . "")
    
71.                  '(100 . "AcDbAlignedDimension")
    
72.                  (cons 13 p13)
    
73.                  (cons 14 p14)
    
74.                  )
    
75.            );endmake  
    
76.   );end defun

;文件名：dbz.lsp<br /> ;;功能说明：标注所选点与设计开挖线之间的距离<br /> ;;;时间：2015-01-06<br /> <br /> (vl-load-com)<br /> (defun c:dbz(/ ss en v-en pc pt pt@curve osm)  <br />   (setq osm (getvar "osmode"))<br />   <br />   (setvar "cmdecho" 0)<br />   (setvar "osmode" 0)  <br /> <br />   (while(progn(prompt "\n请选择设计开挖线：")<br />                 (not(setq ss(ssget ":s" '((0 . "CIRCLE,*POLYLINE,")))))<br />         );end progn<br />     (prompt "\n<<<<未选择到正确的对象，请重新选择!>>>>")<br />   );end while<br /> <br />   (setq en(ssname ss 0)<br />         v-en(vlax-ename->vla-object en))<br />   <br />   (setq pc(find-centerpoint en)) ;找设计开挖线的型心<br /> <br />   (setvar "osmode" 59)<br /> <br />   (setq pt t)<br /> <br />   (while pt<br />     (setq pt(getpoint "\n请在实际开挖线上点选开挖点："))<br />     <br />     (if pt (progn<br />              <br />     (setq pt@curve(vlax-curve-getClosestPointTo v-en pt))<br />     (if(> (distance pt pc) (distance pt@curve pc));如果超挖<br />       (command "-dimstyle" "r" "隧道超挖+"));end if<br /> <br />     (if(< (distance pt pc) (distance pt@curve pc));如果欠挖<br />       (command "-dimstyle" "r" "隧道欠挖-"));end if<br />     <br />     (make-dimension pt pt@curve)<br />     );end progn<br />     );end if    <br />     );end while  <br />   (setvar "osmode" osm) <br />   (princ)  <br />   );end defun<br /> <br /> ;;;sub-routine1<br /> (defun find-centerpoint(en / po-li n y pc)<br />   (setq entda(entget en)<br />         ename(cdr(assoc 0 entda)))<br />   (if(= ename "CIRCLE")<br />     (setq pc(cdr(assoc 10 entda)))<br />     (progn<br />       (setq po-li (vl-remove-if 'not (mapcar '(lambda (x) (if (= (car x) 10) (cdr x))) entda)))<br />       (setq n(length po-li))  <br />       (setq y(apply 'mapcar (cons '+ po-li)))<br />       (setq pc(mapcar '/ y (list n n n)))<br />       );progn<br />     );end if<br />   );end defun<br /> <br /> ;;;sub-routine2<br /> (defun make-dimension (p13 p14)<br />   (entmake (list '(0 . "DIMENSION")<br />                  '(100 . "AcDbEntity")<br />                  '(100 . "AcDbDimension")                 <br />                   (cons 10 p14)<br />                   (cons 11 (polar p14 (angle p14 p13) (* (distance p14 p13) 2) ))<br />                  '(70 . 33)<br />                  '(1 . "")<br />                  '(100 . "AcDbAlignedDimension")<br />                  (cons 13 p13)<br />                  (cons 14 p14)<br />                  )<br />            );endmake  <br />   );end defun

dwp@hamco

各位大大，我写了一个比较粗糙的程序，算是抛砖引玉吧

lizhgang.jin

大师刚才试了一下您的代码，有两个问题，一是标注欠挖显示在图形内侧了，有点不美观，要都在外面就好了。二个问题是比我们以前一个个两点量快点了，要是能自动批量就好了。在程序中先选择设计线，再选择实际线，然后选择隔几点标注，然后就自动标好了，那就美了。个人建议，还是很感谢大师百忙之中来解决我的问题，希望大师能完美一下。谢谢。

lizhgang.jin

所有的标注线都是开挖线到设计线的垂线。开挖线为多断线，实测点为多断线顶点。

lizhgang.jin

设计线和开挖线均为闭合的

lizhgang.jin

各位大师我想要达到的样式在我发的附件示列里了

dwp@hamco

lizhgang.jin 发表于 2015-1-6 17:27
所有的标注线都是开挖线到设计线的垂线。开挖线为多断线，实测点为多断线顶点。

嗯，刚才你说的这两点，改起来不算难。