[LISP程序]：求一个梁箍筋加密，非加密切换的小程序。

alwaysbin

其实就是文字修改工具。
一般梁配箍筋的写法是%%1308@100/200
我的思路是，弄3命令
a1，将@100/200改为@200
a2，将@200改为@100/200
a3，将@200或者是@100/200，都改成@100

说起来是很简单的文字修改，但我不会，不会就要问
请高手指导～～～

它山之石

看看这里
不需要命令
直接双击修改
http://www.tstmr.com/tmr/dispbbs ... p;ID=466&page=2
http://www.ldstruc.cn/read.php?tid=50757

alwaysbin

我下不了啊，要什么提取码，直接发到晓东上来嘛

它山之石

晓东上才真的下不了哦

alwaysbin

老大，预览版完全是调胃口的哈，弄个测试版，大家也好帮你测试一下三。

它山之石

                               
登录/注册后可看大图

dwg001

楼主的要求，请使用如下代码。
3个命令：
a1，将@100/200改为@200
a2，将@200改为@100/200
a3，将@200或者是@100/200，都改成@100

alwaysbin

楼上，下不了你的附件啊，能不能把源码直接贴上来？？

dwg001

老大：给个邮箱，我发给你。

alwaysbin

alwaysbin@163.com

dwg001

已发，请收。

carrot1983

占个位子...
[php]
;;;cjw
(princ "\n |-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|")
(princ "\n| 一般梁配箍筋的写法是%%1308@100/200    |")
(princ "\n| 我的思路是，弄3命令                   |")
(princ "\n| 1，将@100/200改为@200                 |")
(princ "\n| 2，将@200改为@100/200                 |")
(princ "\n| 3，将@200或者是@100/200，都改成@100   |")
(princ "\n |-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|-|")
;;;---------------------------------------
;;kjjj箍筋间距
(defun c:kjjj (/ KW SS)
  (initget "1 2 3")
  (setq        kw
         (getkword
           "\n>>>改为选项:［@200 (1)／@100/200 (2)／@100(3)／］<1>:"
         )
  )
  (if (null kw)
    (setq kw "1")
  )
  (cond
    ((and (= kw "1")
          (setq ss (ssget '((0 . "TEXT") (1 . "*`@100/200"))))
     )
     (progn
       (replace-v1 ss "@200" "@100/200")
     )
    )
    ((and (= kw "2")
          (setq ss (ssget '((0 . "TEXT") (1 . "*`@200"))))
     )
     (progn
       (replace-v1 ss "@100/200" "@200")
     )
    )
    ((and (= kw "3")
          (setq ss (ssget '((0 . "TEXT") (1 . "*`@200,*`@100/200"))))
     )
     (progn
       (replace-v1 ss "@100" "@200")
       (replace-v1 ss "@100" "@100/200")
     )
    )
  )
  (princ)
)

;;replace-v1替换值
(defun replace-v1 (ss A B / data v1 val)
  (setq elst (ss->elst ss))
  (foreach e elst
    (setq data (entget e))
    (setq v1 (cdr (assoc 1 data)))
    (setq val (vl-string-subst A B v1))
    (setq data (subst (cons 1 val) (assoc 1 data) data))
    (entmod data)
  )
)


;;ss->elst选择集->图元表
(defun ss->elst        (ss / elst)
  (setq i 0)
  (repeat (sslength ss)
    (setq elst (cons (ssname ss i) elst)
          i    (1+ i)
    )
  )
  (reverse elst)
)

[/php]

aeo

很久没写了，玩玩！

2. 
   
3. ;a1 加密，不加密切换
   
4. ;a2 减半
   
5. 
   
6. (defun dxf(n lst)(cdr(assoc n lst)))  
   
7. (defun c:a1( / e n1 n2 newtxt newtxt1 newtxt2 txt)
   
8.   (if(and (setq e(car(entsel)))
   
9.           (setq e(entget e))
   
10.           (= "TEXT"(dxf 0 e))
    
11.           (setq txt(dxf 1 e))  
    
12.      )
    
13.     (cond
    
14.        ((wcmatch txt "*`@*/*")
    
15.           (setq n1(vl-string-search "@"txt)
    
16.              n2(vl-string-search "/"txt)
    
17.            )
    
18.           (setq newtxt(strcat(substr txt 1 (1+ n1))(substr txt(+ 2 n2))))
    
19.           (entmod(subst(cons 1 newtxt)(assoc 1 e)e))
    
20.        )
    
21.        ((wcmatch txt "*`@*")
    
22.          (setq n1(vl-string-search "@"txt)
    
23.               newtxt1(substr txt (+ 2 n1))
    
24.               newtxt2(itoa(/(atoi newtxt1)2))
    
25.           )
    
26.          (setq newtxt(strcat(substr txt 1 (1+ n1))newtxt2"/"newtxt1))
    
27.          (entmod(subst(cons 1 newtxt)(assoc 1 e)e))
    
28.        )
    
29.       
    
30.   ))(princ)
    
31. )
    
32. 
    
33. (defun c:a2( / e n1 newtxt newtxt1 txt)
    
34.   (if(and (setq e(car(entsel)))
    
35.           (setq e(entget e))  
    
36.           (= "TEXT"(dxf 0 e))
    
37.           (setq txt(dxf 1 e))      
    
38.      )
    
39.      (progn
    
40.        (cond( (wcmatch txt"*#/#*")
    
41.               (setq newtxt(substr txt 1 (vl-string-search "/"txt)))
    
42.           )
    
43.           ((wcmatch txt "*`@*")
    
44.              (setq n1(vl-string-search "@"txt)
    
45.                    newtxt1(substr txt (+ 2 n1))
    
46.                    newtxt1(itoa(/(atoi newtxt1)2))
    
47.              )
    
48.              (setq newtxt(strcat(substr txt 1 (1+ n1))newtxt1))      
    
49.           )
    
50.         )
    
51.          (entmod(subst(cons 1 newtxt)(assoc 1 e)e))
    
52.   ))
    
53. (princ)
    
54. )
    

<br /> ;a1 加密，不加密切换<br /> ;a2 减半<br /> <br /> (defun dxf(n lst)(cdr(assoc n lst)))  <br /> (defun c:a1( / e n1 n2 newtxt newtxt1 newtxt2 txt)<br />   (if(and (setq e(car(entsel))) <br />           (setq e(entget e)) <br />           (= "TEXT"(dxf 0 e))<br />           (setq txt(dxf 1 e))  <br />      )<br />     (cond <br />        ((wcmatch txt "*`@*/*")<br />           (setq n1(vl-string-search "@"txt)<br />              n2(vl-string-search "/"txt)<br />            )<br />           (setq newtxt(strcat(substr txt 1 (1+ n1))(substr txt(+ 2 n2))))<br />           (entmod(subst(cons 1 newtxt)(assoc 1 e)e))<br />        )<br />        ((wcmatch txt "*`@*")<br />          (setq n1(vl-string-search "@"txt)<br />               newtxt1(substr txt (+ 2 n1))<br />               newtxt2(itoa(/(atoi newtxt1)2))<br />           )<br />          (setq newtxt(strcat(substr txt 1 (1+ n1))newtxt2"/"newtxt1))<br />          (entmod(subst(cons 1 newtxt)(assoc 1 e)e))<br />        )<br />        <br />   ))(princ)<br /> )<br /> <br /> (defun c:a2( / e n1 newtxt newtxt1 txt)<br />   (if(and (setq e(car(entsel))) <br />           (setq e(entget e))  <br />           (= "TEXT"(dxf 0 e))<br />           (setq txt(dxf 1 e))      <br />      )<br />      (progn<br />        (cond( (wcmatch txt"*#/#*")<br />               (setq newtxt(substr txt 1 (vl-string-search "/"txt)))<br />           )<br />           ((wcmatch txt "*`@*")<br />              (setq n1(vl-string-search "@"txt)<br />                    newtxt1(substr txt (+ 2 n1)) <br />                    newtxt1(itoa(/(atoi newtxt1)2))<br />              ) <br />              (setq newtxt(strcat(substr txt 1 (1+ n1))newtxt1))      <br />           )<br />         )<br />          (entmod(subst(cons 1 newtxt)(assoc 1 e)e))<br />   ))<br /> (princ)<br /> )<br />

又:
如果像楼上的，只是100和200
建议直接用find命令就可

alwaysbin

谢谢各位了，已经搞定！！！