[编程申请]：将形式Dz]* x/y变成形式Dx]*/y]*

lengliqun

z、x、y为正数，且z=x+y
将形式Dz]* x/y变成形式Dx]*/y]*如
D12]25 6/6变成D6]25/6]25
D12]25 4/8变成D4]25/8]25
D9]20 4/5变成D4]20/5]20
D7]22 3/4变成D3]22/4]22
余类推
请下载附件测试，谢谢。

zxq0220

程序：

2. 
   
3. ;z、x、y为正数，且z=x+y
   
4. ;将形式Dz]* x/y变成形式Dx]*/y]*如
   
5. ;D12]25 6/6变成D6]25/6]25
   
6. ;D12]25 4/8变成D4]25/8]25
   
7. ;D9]20 4/5变成D4]20/5]20
   
8. ;D7]22 3/4变成D3]22/4]22
   
9. 
   
10. ;;晓东 zxq0220
    
11. 
    
12. (DEFUN C:CHSTR4 ()
    
13. (IF (SETQ SS (SSGET "X" '((0 . "TEXT") (1 . "D*]*/*")))) (PROGN
    
14.   (SETQ I 0)
    
15.   (REPEAT (SSLENGTH SS)
    
16.    (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I)
    
17.          STR (CDR (ASSOC 1 ENT))
    
18.          STL (STRLEN STR)
    
19.          J 2)
    
20.    (IF (NOT (WCMATCH STR "D*]*/*]*")) (PROGN
    
21.     (WHILE (AND (< J STL) (/= (SUBSTR STR J 1) "]")) (SETQ J (1+ J)))
    
22.     (SETQ Z (SUBSTR STR 2 (- J 2)) K (1+ J))
    
23.     (WHILE (AND (< J STL) (/= (SUBSTR STR J 1) " ")) (SETQ J (1+ J)))
    
24.     (SETQ SSTT (SUBSTR STR K (- J K)) K (1+ J))
    
25.     (WHILE (AND (< J STL) (/= (SUBSTR STR J 1) "/")) (SETQ J (1+ J)))
    
26.     (SETQ X (SUBSTR STR K (- J K)))
    
27.     (SETQ Y (SUBSTR STR (1+ J)))
    
28.     (IF (= (+ (ATOI X) (ATOI Y)) (ATOI Z)) (PROGN
    
29.      (SETQ STR (STRCAT "D" X "]" SSTT "/" Y "]" SSTT))
    
30.      (SETQ ENT (SUBST (CONS 1 STR) (ASSOC 1 ENT) ENT))
    
31.      (ENTMOD ENT)
    
32.     ))
    
33.    ))
    
34.   )
    
35. ))
    
36. (PRINC)
    
37. )
    

<br /> ;z、x、y为正数，且z=x+y<br /> ;将形式Dz]* x/y变成形式Dx]*/y]*如<br /> ;D12]25 6/6变成D6]25/6]25<br /> ;D12]25 4/8变成D4]25/8]25<br /> ;D9]20 4/5变成D4]20/5]20<br /> ;D7]22 3/4变成D3]22/4]22<br /> <br /> ;;晓东 zxq0220<br /> <br /> (DEFUN C:CHSTR4 ()<br /> (IF (SETQ SS (SSGET "X" '((0 . "TEXT") (1 . "D*]*/*")))) (PROGN<br />   (SETQ I 0)<br />   (REPEAT (SSLENGTH SS)<br />    (SETQ ENT (ENTGET (SSNAME SS I)) I (1+ I)<br />          STR (CDR (ASSOC 1 ENT))<br />          STL (STRLEN STR)<br />          J 2)<br />    (IF (NOT (WCMATCH STR "D*]*/*]*")) (PROGN<br />     (WHILE (AND (< J STL) (/= (SUBSTR STR J 1) "]")) (SETQ J (1+ J)))<br />     (SETQ Z (SUBSTR STR 2 (- J 2)) K (1+ J))<br />     (WHILE (AND (< J STL) (/= (SUBSTR STR J 1) " ")) (SETQ J (1+ J)))<br />     (SETQ SSTT (SUBSTR STR K (- J K)) K (1+ J))<br />     (WHILE (AND (< J STL) (/= (SUBSTR STR J 1) "/")) (SETQ J (1+ J)))<br />     (SETQ X (SUBSTR STR K (- J K)))<br />     (SETQ Y (SUBSTR STR (1+ J)))<br />     (IF (= (+ (ATOI X) (ATOI Y)) (ATOI Z)) (PROGN<br />      (SETQ STR (STRCAT "D" X "]" SSTT "/" Y "]" SSTT))<br />      (SETQ ENT (SUBST (CONS 1 STR) (ASSOC 1 ENT) ENT))<br />      (ENTMOD ENT)<br />     ))<br />    ))<br />   )<br /> ))<br /> (PRINC)<br /> )<br />

lengliqun

CAD2002测试可用，连回车都免了，谢谢。