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

5240xiao

老大这是DWG的，R14版的

5240xiao

现在就是改了数字不对，你真是历害

5240xiao

我要出差一会了，这几天不来了

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 (- L NEWL))
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 (- L NEWL))    (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) )

5240xiao

今天有个机会来上网，呵，可以用了，大哥，谢谢你了

ZZXXQQ

14楼程序还有BUG。下面是最后调试好的程序。

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

(DEFUN C:DIMCHANGE ()   (SETVAR "CMDECHO" 0)   (SETQ OLDOS (GETvar "OSMODE"))   (PRINC "\n选择被驱动的实体:")   (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))                DTYP (CDR (ASSOC 100 (REVERSE SD-DXF))))    (IF (= DTYP "AcDbAlignedDimension")      (SETQ ANG (ANGLE SP EP)                  L (DISTANCE SP EP))      (IF (EQUAL ANG 0.0 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 (IF (= DTYP "AcDbAlignedDimension") (- L NEWL)                          (IF (EQUAL ANG 0.0 0.00001) (- L NEWL) (- 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 EP ANG (+ ANG PI) BSB (* BSB -1))      (SETQ SSP SP)    )    (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) )