[求助]求个和标注有关的程序%%%%%在XD求了很久没人解决

5240xiao

cad标注改了数字长度不变，我想要个改了数字长度也变的程序

5240xiao

目的是为了这个：：：在工作中经常需要测量两个物体的距离，然后修改他门的距离，
我想是否能线性标注点一个物体上的一点（移动物休），然后点到目标物体，然后修改标注数字
就能把（移动物休）移动适和这个标注数字,(这个数字就是它们的间距）

ZZXXQQ

给个示意图看看。

5240xiao

如此图

5240xiao

这个

ZZXXQQ

这不就是尺寸驱动吗。不太好解决。楼主可以用stretch命令进行处理。注意要用交叉虚框选取物体及尺寸的一个界限，拉移的距离是（在图中是1194-1000）。

5240xiao

原来如此，，麻烦你了

ZZXXQQ

不过您可以试一下下面的程序，看能否满足您的要求。

2. (DEFUN C:DIMCHANGE ()
3.   (SETVAR "CMDECHO" 0)
4.   (SETQ OLDOS (GETVAR "OSMODE"))
5.   (SETQ SB (ENTSEL "\nSelect Block(s) 选择图块:"))
6.   (SETQ SB-DXF (ENTGET (CAR SB)))
7.   (WHILE (NOT (WCMATCH (CDR (ASSOC 0 SB-DXF)) "*INS*"))
8.    (SETQ SB (ENTSEL "\nSelect Block(s) 选择图块:"))
9.    (SETQ SB-DXF (ENTGET (CAR SB)))
10.   )
11.   (SETQ SD (ENTSEL "\nSelect a Dimtion 选择驱动尺寸:"))
12.   (SETQ SD-DXF (ENTGET (CAR SD)))
13.   (WHILE (NOT (WCMATCH (CDR (ASSOC 0 SD-DXF)) "*DIM*"))
14.    (SETQ SD (ENTSEL "\nSelect a Dimtion 选择驱动尺寸:"))
15.    (SETQ SD-DXF (ENTGET (CAR SD)))
16.   )
17.   (IF (AND SB SD) (PROGN
18.    (SETQ SP (CDR (ASSOC 13 SD-DXF))
19.                EP (CDR (ASSOC 14 SD-DXF))
20.                ANG (CDR (ASSOC 50 SD-DXF)))
21.    (IF (OR (EQUAL ANG 0.0 0.00001) (EQUAL ANG PI 0.00001))
22.      (SETQ L (ABS (- (CAR SP) (CAR EP))))
23.      (SETQ L (ABS (- (CADR SP) (CADR EP))))
24.    )
25.    (PRINC "\nEnter New Distance 新的长度<") (PRINC L)
26.    (SETQ NEWL (GETDIST ">:"))
27.    (WHILE (EQ NEWL nil)
28.    (PRINC "\nEnter New Distance 新的长度<") (PRINC L)
29.      (SETQ NEWL (GETDIST ">:"))
30.    )
31.    (SETQ BSB (- NEWL L))
32.    (SETQ SS1 (SSGET "C" SP SP))
33.    (SETQ SS2 (SSGET "C" EP EP))
34.    (IF (SSDEL (CAR SB) SS1)
35.      (SETQ SSP SP)
36.      (SETQ SSP EP ANG (+ ANG PI) BSB (* BSB -1))
37.    )
38.    (SETQ N-SP (POLAR SSP ANG BSB))
39.    (SETVAR "OSMODE" 0)
40.    (COMMAND "_.UNDO" "_GROUP")
41.    (COMMAND "MOVE" (CAR SB) "" SSP N-SP "STRETCH" "C" SSP SSP "" SSP N-SP)
42.    (COMMAND "_.UNDO" "_END")
43.    (SETVAR "OSMODE" OLDOS)
44.   ))
45.   (SETVAR "CMDECHO" 1)
46.   (princ)
47. )

(DEFUN C:DIMCHANGE ()   (SETVAR "CMDECHO" 0)   (SETQ OLDOS (GETVAR "OSMODE"))   (SETQ SB (ENTSEL "\nSelect Block(s) 选择图块:"))   (SETQ SB-DXF (ENTGET (CAR SB)))   (WHILE (NOT (WCMATCH (CDR (ASSOC 0 SB-DXF)) "*INS*"))    (SETQ SB (ENTSEL "\nSelect Block(s) 选择图块:"))    (SETQ SB-DXF (ENTGET (CAR SB)))   )   (SETQ SD (ENTSEL "\nSelect a Dimtion 选择驱动尺寸:"))   (SETQ SD-DXF (ENTGET (CAR SD)))   (WHILE (NOT (WCMATCH (CDR (ASSOC 0 SD-DXF)) "*DIM*"))    (SETQ SD (ENTSEL "\nSelect a Dimtion 选择驱动尺寸:"))    (SETQ SD-DXF (ENTGET (CAR SD)))   )   (IF (AND SB SD) (PROGN    (SETQ SP (CDR (ASSOC 13 SD-DXF))                EP (CDR (ASSOC 14 SD-DXF))                ANG (CDR (ASSOC 50 SD-DXF)))    (IF (OR (EQUAL ANG 0.0 0.00001) (EQUAL ANG PI 0.00001))      (SETQ L (ABS (- (CAR SP) (CAR EP))))      (SETQ L (ABS (- (CADR SP) (CADR EP))))    )    (PRINC "\nEnter New Distance 新的长度<") (PRINC L)    (SETQ NEWL (GETDIST ">:"))    (WHILE (EQ NEWL nil)    (PRINC "\nEnter New Distance 新的长度<") (PRINC L)      (SETQ NEWL (GETDIST ">:"))    )    (SETQ BSB (- NEWL L))    (SETQ SS1 (SSGET "C" SP SP))    (SETQ SS2 (SSGET "C" EP EP))    (IF (SSDEL (CAR SB) SS1)      (SETQ SSP SP)      (SETQ SSP EP ANG (+ ANG PI) BSB (* BSB -1))    )    (SETQ N-SP (POLAR SSP ANG BSB))    (SETVAR "OSMODE" 0)    (COMMAND "_.UNDO" "_GROUP")    (COMMAND "MOVE" (CAR SB) "" SSP N-SP "STRETCH" "C" SSP SSP "" SSP N-SP)    (COMMAND "_.UNDO" "_END")    (SETVAR "OSMODE" OLDOS)   ))   (SETVAR "CMDECHO" 1)   (princ) )

5240xiao

大哥，我用了一下有个问题，当我输入新长度的时候不对（本来是423的，我输入400，那个数变成了，448）不知道怎么回事，选择物体能不多点，不要只能选择块，在这先谢谢你了

ZZXXQQ

更改的程序如下：

2. (DEFUN C:DIMCHANGE ()
3.   (SETVAR "CMDECHO" 0)
4.   (SETQ OLDOS (GETVAR "OSMODE"))
5.   (IF (SETQ SB (SSGET)) (PROGN
6.    (SETQ SD (ENTSEL "\nSelect a Dimtion 选择驱动尺寸:"))
7.    (SETQ SD-DXF (ENTGET (CAR SD)))
8.    (WHILE (NOT (WCMATCH (CDR (ASSOC 0 SD-DXF)) "*DIM*"))
9.      (SETQ SD (ENTSEL "\nSelect a Dimtion 选择驱动尺寸:"))
10.      (SETQ SD-DXF (ENTGET (CAR SD)))
11.    )
12.    (SETQ SP (CDR (ASSOC 13 SD-DXF))
13.                EP (CDR (ASSOC 14 SD-DXF))
14.                ANG (CDR (ASSOC 50 SD-DXF)))
15.    (IF (OR (EQUAL ANG 0.0 0.00001) (EQUAL ANG PI 0.00001))
16.      (SETQ L (ABS (- (CAR SP) (CAR EP))))
17.      (SETQ L (ABS (- (CADR SP) (CADR EP))))
18.    )
19.    (PRINC "\nEnter New Distance 新的长度<") (PRINC L)
20.    (SETQ NEWL (GETDIST ">:")
21.                NEWL (IF NEWL NEWL L))
22.    (SETQ BSB (- NEWL L))
23.    (SETQ SS1 (SSGET "C" SP SP))
24.    (SETQ SL (SSLENGTH SB) I 0 J -1)
25.    (REPEAT SL
26.      (IF (SSDEL (SSNAME SB I) SS1) (SETQ J I))
27.      (SETQ I (1+ I))
28.    )
29.    (IF (>= J 0)
30.      (SETQ SSP SP)
31.      (SETQ SSP EP ANG (+ ANG PI) BSB (* BSB -1))
32.    )
33.    (SETQ N-SP (POLAR SSP ANG BSB))
34.    (SETVAR "OSMODE" 0)
35.    (COMMAND "_.UNDO" "_GROUP")
36.    (COMMAND "MOVE" SB "" SSP N-SP "STRETCH" "C" SSP SSP "" SSP N-SP)
37.    (COMMAND "_.UNDO" "_END")
38.    (SETVAR "OSMODE" OLDOS)
39.   ))
40.   (SETVAR "CMDECHO" 1)
41.   (princ)
42. )

(DEFUN C:DIMCHANGE ()   (SETVAR "CMDECHO" 0)   (SETQ OLDOS (GETVAR "OSMODE"))   (IF (SETQ SB (SSGET)) (PROGN    (SETQ SD (ENTSEL "\nSelect a Dimtion 选择驱动尺寸:"))    (SETQ SD-DXF (ENTGET (CAR SD)))    (WHILE (NOT (WCMATCH (CDR (ASSOC 0 SD-DXF)) "*DIM*"))      (SETQ SD (ENTSEL "\nSelect a Dimtion 选择驱动尺寸:"))      (SETQ SD-DXF (ENTGET (CAR SD)))    )    (SETQ SP (CDR (ASSOC 13 SD-DXF))                EP (CDR (ASSOC 14 SD-DXF))                ANG (CDR (ASSOC 50 SD-DXF)))    (IF (OR (EQUAL ANG 0.0 0.00001) (EQUAL ANG PI 0.00001))      (SETQ L (ABS (- (CAR SP) (CAR EP))))      (SETQ L (ABS (- (CADR SP) (CADR EP))))    )    (PRINC "\nEnter New Distance 新的长度<") (PRINC L)    (SETQ NEWL (GETDIST ">:")                NEWL (IF NEWL NEWL L))    (SETQ BSB (- NEWL L))    (SETQ SS1 (SSGET "C" SP SP))    (SETQ SL (SSLENGTH SB) I 0 J -1)    (REPEAT SL      (IF (SSDEL (SSNAME SB I) SS1) (SETQ J I))      (SETQ I (1+ I))    )    (IF (>= J 0)      (SETQ SSP SP)      (SETQ SSP EP ANG (+ ANG PI) BSB (* BSB -1))    )    (SETQ N-SP (POLAR SSP ANG BSB))    (SETVAR "OSMODE" 0)    (COMMAND "_.UNDO" "_GROUP")    (COMMAND "MOVE" SB "" SSP N-SP "STRETCH" "C" SSP SSP "" SSP N-SP)    (COMMAND "_.UNDO" "_END")    (SETVAR "OSMODE" OLDOS)   ))   (SETVAR "CMDECHO" 1)   (princ) )

另外：为更好的调试程序，请发一张dwg图上来，或发到我的邮箱中。