[求助]求个和标注有关的程序%%%%%在XD求了很久没人解决
cad标注改了数字长度不变,我想要个改了数字长度也变的程序 <FONT face=宋体 size=2>目的是为了这个:::在工作中经常需要测量两个物体的距离,然后修改他门的距离,<BR>我想是否能线性标注点一个物体上的一点(移动物休),然后点到目标物体,然后修改标注数字<BR>就能把(移动物休)移动适和这个标注数字,(这个数字就是它们的间距)</FONT> 给个示意图看看。 如此图 这个这不就是尺寸驱动吗。不太好解决。楼主可以用stretch命令进行处理。注意要用交叉虚框选取物体及尺寸的一个界限,拉移的距离是(在图中是1194-1000)。 原来如此,,麻烦你了 不过您可以试一下下面的程序,看能否满足您的要求。(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)
) 大哥,我用了一下有个问题,当我输入新长度的时候不对(本来是423的,我输入400,那个数变成了,448)不知道怎么回事,选择物体能不多点,不要只能选择块,在这先谢谢你了 更改的程序如下:(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图上来,或发到我的邮箱中。
页:
[1]
2