5240xiao 发表于 2005-4-16 14:24:00

老大这是DWG的，R14版的

5240xiao 发表于 2005-4-16 14:38:00

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

5240xiao 发表于 2005-4-16 14:43:00

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

ZZXXQQ 发表于 2005-4-17 00:25:00

经过调试的程序：(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 发表于 2005-4-17 11:34:00

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

ZZXXQQ 发表于 2005-4-17 12:17:00

14楼程序还有BUG。下面是最后调试好的程序。(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)
)
页: 1 [2]
查看完整版本: [求助]求个和标注有关的程序%%%%%在XD求了很久没人解决