[LISP程序]：梁排号,梁编号递增修改lsp程序两个

梦断江南

今天看到一篇有过梁排号的帖子.想起以前应同事之请曾经写过两个梁排号,梁编号递增修改lsp程序,翻翻以前的目录,找出来给大家看看.因为我不是学结构的,也没有去测试过,依稀记得当时是有用的.有好几个版本,不知哪个是可以正常运行的,所以没有放到我的老巢----程序库板块,而是发到这里. :),如果可用,别忘了告诉我一声.

2. 
   
3. (princ "\n ttln----梁编号递增修改v1.0---for结构------lxx.2001.11")
   
4. ;;
   
5. (defun c:ttln ( / n roop ent entl e1 str1 i str2 i2 str3)
   
6.   (princ "\nttln----梁编号递增修改v1.0---for结构------lxx.2001.11")
   
7.   (princ "\n!只针对前缀 kl xl 的梁编号txt!")
   
8.   (setq n (getint "\n起始编号:")
   
9.         roop "true"
   
10.         i 2)
    
11.   (while roop
    
12.    (initget "X C R  ")
    
13.    (setq ent (entsel "\n<X-退出>/C-序号重复/R-重设序号/选择梁编号:"))
    
14.    (cond
    
15.     ((or (= "x" ent)(= "X" ent)(= "" ent)(= " " ent))
    
16.       (setq roop nil)
    
17.     );<X-退出>
    
18.     ((or (= "C" ent)(= "c" ent))
    
19.       (setq n (1- n))
    
20.     );C-序号重复
    
21.     ((or (= "R" ent)(= "r" ent))
    
22.       (princ "\n当前序号:")(princ n)
    
23.       (setq n (getint "\n重设当前序号为:"))
    
24.     )
    
25.     ((= nil ent)(princ "\n没有选中编号,请重新选择:"))
    
26.      ((progn
    
27.       (setq entl (entget (car ent))
    
28.             e1  (cdr(assoc 1 entl))
    
29.            str1 (substr e1 1 2)
    
30.       )
    
31.       (or (wcmatch (strcase str1) "KL*")
    
32.           (wcmatch (strcase str1) "XL*")
    
33.       )
    
34.       );
    
35.       (princ "\n当前序号:")(princ n)
    
36.       (if (= " " (substr e1 3 1))
    
37.           (setq i 3 str1 (strcat str1 " "))
    
38.           (setq i 2)
    
39.       )
    
40.       (setq str2(substr e1 (1+ i))
    
41.            str2 (rtos (atoi str2) 2 0)
    
42.             i2  (strlen str2)
    
43.           str3  (substr e1 (+ i i2 1))
    
44.             e1  (strcat str1 (itoa n) str3)
    
45.           entl  (subst (cons 1 e1) (assoc 1 entl) entl)
    
46.              n  (1+ n)
    
47.       )
    
48.       (entmod entl)
    
49.     );end case
    
50.    
    
51.   );end cond
    
52. );end while
    
53. (princ)
    
54. )
    
55.             
    
56.   
    

<br /> (princ "\n ttln----梁编号递增修改v1.0---for结构------lxx.2001.11")<br /> ;;<br /> (defun c:ttln ( / n roop ent entl e1 str1 i str2 i2 str3)<br />   (princ "\nttln----梁编号递增修改v1.0---for结构------lxx.2001.11")<br />   (princ "\n!只针对前缀 kl xl 的梁编号txt!")<br />   (setq n (getint "\n起始编号:")<br />         roop "true"<br />         i 2)<br />   (while roop<br />    (initget "X C R  ")<br />    (setq ent (entsel "\n<X-退出>/C-序号重复/R-重设序号/选择梁编号:"))<br />    (cond<br />     ((or (= "x" ent)(= "X" ent)(= "" ent)(= " " ent))<br />       (setq roop nil)<br />     );<X-退出><br />     ((or (= "C" ent)(= "c" ent))<br />       (setq n (1- n))<br />     );C-序号重复<br />     ((or (= "R" ent)(= "r" ent))<br />       (princ "\n当前序号:")(princ n)<br />       (setq n (getint "\n重设当前序号为:"))<br />     )<br />     ((= nil ent)(princ "\n没有选中编号,请重新选择:"))<br />      ((progn<br />       (setq entl (entget (car ent))<br />             e1  (cdr(assoc 1 entl))<br />            str1 (substr e1 1 2)<br />       )<br />       (or (wcmatch (strcase str1) "KL*")<br />           (wcmatch (strcase str1) "XL*")<br />       )<br />       );<br />       (princ "\n当前序号:")(princ n)<br />       (if (= " " (substr e1 3 1))<br />           (setq i 3 str1 (strcat str1 " "))<br />           (setq i 2)<br />       )<br />       (setq str2(substr e1 (1+ i))<br />            str2 (rtos (atoi str2) 2 0)<br />             i2  (strlen str2)<br />           str3  (substr e1 (+ i i2 1))<br />             e1  (strcat str1 (itoa n) str3) <br />           entl  (subst (cons 1 e1) (assoc 1 entl) entl)<br />              n  (1+ n)<br />       )<br />       (entmod entl)<br />     );end case<br />     <br />   );end cond<br /> );end while<br /> (princ)<br /> )<br />             <br />   <br />

2. 
   
3. (princ "\n ttls----梁编号重排v1.0---for结构------lxx.2001.11")
   
4. ;;
   
5. (defun c:ttls ( / kls0 key ss i ent entl e10 e-1 elist la i e1 ent entl str1 n1 str2 str3 roop kls); 起始编号
   
6.   (princ "\n ttls----梁编号重排v1.0---for结构------lxx.2001.11")
   
7.   (initget "Xl重排 Kl重排")
   
8.   (if (not kls)
   
9.     (setq kls 1 kls0 kls)
   
10.     (setq kls0 kls)
    
11.   )
    
12.   (setq key (getkword "\nXl重排/Kl重排:")
    
13.         roop "true")
    
14. (while roop
    
15.   (initget 128)
    
16.   (setq kls0 kls)
    
17.   (setq kls (getint (strcat "\nX-退出/起始编号<" (rtos kls 2 0) ">:")))
    
18.   (if (or (= "X" kls)(= "x" kls)) (quit))
    
19.   (if (= nil kls)(setq kls kls0))
    
20.   (cond
    
21.     ((= "Xl重排" key)
    
22.       (setq ss (ssget '((0 . "TEXT") (1 . "XL*"))))
    
23.     )
    
24.     ((= "Kl重排" key)
    
25.       (setq ss (ssget '((0 . "TEXT") (1 . "KL*"))))
    
26.     )
    
27.   )
    
28.   (setq i 0 elist '())
    
29.   (repeat (sslength ss)
    
30.     (setq ent (ssname ss i)
    
31.           entl (entget ent)
    
32.           e10 (car (cdr (assoc 10 entl)))
    
33.           e-1 (cdr (assoc -1 entl))
    
34.           i (1+ i)
    
35.           elist (cons (LIST e10 (cdr (assoc 1 entl)) e-1) elist)
    
36.     )
    
37.   );end repeat
    
38.   (setq elist (vl-sort elist (function (lambda (l1 l2) (< (car l1)(car l2)) ))));按照x值排序
    
39.   (foreach n elist (sortn))
    
40.   (princ "\n本次编号从 ")(princ kls0)(princ " 到 ")(princ (1- kls))
    
41. );end while
    
42.   (princ)
    
43. )
    
44. ;重排编号(sortn)
    
45. (defun sortn ()
    
46.   (setq e1 (cadr n)
    
47.         ent2 (last n)
    
48.         entl2 (entget ent2)
    
49.         n1 2
    
50.         str1 (substr e1 1 n1)       
    
51.   )
    
52.   (if (= " " (substr e1 3 1))
    
53.       (setq str1 (strcat str1  " ")
    
54.                  n1 (1+ n1))
    
55.   )
    
56.   (setq      str2  (substr e1 (1+ n1))
    
57.              str2  (rtos (atoi str2) 2 0)
    
58.                n2  (strlen str2)
    
59.              str3  (substr e1 (+ n1 n2 1))
    
60.              str2  (rtos kls 2 0)
    
61.                e1  (strcat str1 str2 str3)
    
62.              entl2  (subst (cons 1 e1) (assoc 1 entl2) entl2)
    
63.                kls  (1+ kls)
    
64.   )
    
65.   (entmod entl2)
    
66. )
    
67. 
    

<br /> (princ "\n ttls----梁编号重排v1.0---for结构------lxx.2001.11")<br /> ;;<br /> (defun c:ttls ( / kls0 key ss i ent entl e10 e-1 elist la i e1 ent entl str1 n1 str2 str3 roop kls); 起始编号<br />   (princ "\n ttls----梁编号重排v1.0---for结构------lxx.2001.11")<br />   (initget "Xl重排 Kl重排")<br />   (if (not kls)<br />     (setq kls 1 kls0 kls)<br />     (setq kls0 kls)<br />   )<br />   (setq key (getkword "\nXl重排/Kl重排:")<br />         roop "true")<br /> (while roop<br />   (initget 128)<br />   (setq kls0 kls)<br />   (setq kls (getint (strcat "\nX-退出/起始编号<" (rtos kls 2 0) ">:")))<br />   (if (or (= "X" kls)(= "x" kls)) (quit))<br />   (if (= nil kls)(setq kls kls0))<br />   (cond<br />     ((= "Xl重排" key)<br />       (setq ss (ssget '((0 . "TEXT") (1 . "XL*"))))<br />     )<br />     ((= "Kl重排" key)<br />       (setq ss (ssget '((0 . "TEXT") (1 . "KL*"))))<br />     )<br />   )<br />   (setq i 0 elist '())<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i)<br />           entl (entget ent)<br />           e10 (car (cdr (assoc 10 entl)))<br />           e-1 (cdr (assoc -1 entl))<br />           i (1+ i)<br />           elist (cons (LIST e10 (cdr (assoc 1 entl)) e-1) elist)<br />     )<br />   );end repeat<br />   (setq elist (vl-sort elist (function (lambda (l1 l2) (< (car l1)(car l2)) ))));按照x值排序<br />   (foreach n elist (sortn))<br />   (princ "\n本次编号从 ")(princ kls0)(princ " 到 ")(princ (1- kls))<br /> );end while<br />   (princ)<br /> )<br /> ;重排编号(sortn)<br /> (defun sortn ()<br />   (setq e1 (cadr n)<br />         ent2 (last n)<br />         entl2 (entget ent2)<br />         n1 2<br />         str1 (substr e1 1 n1)        <br />   )<br />   (if (= " " (substr e1 3 1))<br />       (setq str1 (strcat str1  " ")<br />                  n1 (1+ n1))<br />   )<br />   (setq      str2  (substr e1 (1+ n1))<br />              str2  (rtos (atoi str2) 2 0)<br />                n2  (strlen str2)<br />              str3  (substr e1 (+ n1 n2 1))<br />              str2  (rtos kls 2 0)<br />                e1  (strcat str1 str2 str3) <br />              entl2  (subst (cons 1 e1) (assoc 1 entl2) entl2)<br />                kls  (1+ kls)<br />   )<br />   (entmod entl2)<br /> )<br /> <br />

附件压缩包里面一共有5个lsp文件,但是功能就两个,如上.因为记不得那个能用了--也许都可以:) .所以一起打包上来.

cy956

我是建筑的，也帮结构的弟兄写过这样的东东。

dynasty

这个功能太实用了，我一直被这个问题困扰着。谢谢了！

pxt2001

非常感谢“梦断江南”斑竹，这个梁排号lisp正是我期待的。我试用了一下，很好用。感谢斑竹的无私奉献，虽然他不是做结构的。相信许多做结构设计的很需要这个！
不过我把程序里面的XL改为了LL，这样pkpm生成的梁平法图中的KL*  LL*都可以重排号。然后用find将LL全部改为L。

cnsteel

确实很有用，编号与梁线的距离怎样可调

laolin

梁编号重排ttls对每根梁号都按顺序编不同的号，这对于梁表确实有用。不过现在用的是平法表示，图中有许多相同的梁号，用此程序就不行了。不知斑竹能不能修改一下，相同的梁号修改后还是相同的，并且按原来的梁号从小到大修改。辛苦了！

乐逍遥

最初由 laolin 发布
[B]梁编号重排ttls对每根梁号都按顺序编不同的号，这对于梁表确实有用。不过现在用的是平法表示，图中有许多相同的梁号，用此程序就不行了。不知斑竹能不能修改一下，相同的梁号修改后还是相同的，并且按原来的梁号从小... [/B]

是否可以按此思路修改一下呢？谢谢

fallenleaf

强人啊，偶得学了

梦断江南

最初由 laolin 发布
[B]梁编号重排ttls对每根梁号都按顺序编不同的号，这对于梁表确实有用。不过现在用的是平法表示，图中有许多相同的梁号，用此程序就不行了。不知斑竹能不能修改一下，相同的梁号修改后还是相同的，并且按原来的梁号从小... [/B]

我不是学结构的，所以不提具体的（具有可操作性的）要求我是不知道你们要什么样的。

小鱼儿

希望对大家有用

乐逍遥

最初由 梦断江南 发布
[B][QUOTE]最初由 laolin 发布
[B]梁编号重排ttls对每根梁号都按顺序编不同的号，这对于梁表确实有用。不过现在用的是平法表示，图中有许多相同的梁号，用此程序就不行了。不知斑竹能不能修改一下，相同的梁号?.. [/B]

pkpm生成的梁平法配筋图中，比如有KL1至KL8，其中KL3有两根梁，现人为将KL2归并为KL1，梁编号重排时使相同的梁号（即所有编为KL3的梁编号均变为KL2）相同。
如图所示

乐逍遥

从新排号后

xjlmlxbq

asde有此功能

laolin

电脑里已装了探索者、晓东工具箱，所以不想为这个功能再装ASDE软件，若能有一个小程序就解决问题就好了。
    逍遥兄把问题图示得很清楚了，不过简单点说就是，有几个编号，如：KL2[/COLOR] (3)、KL4[/COLOR] (2)、KL4[/COLOR] (2)、KL6[/COLOR] (4)等，经重新编号后为：KL1[/COLOR] (3)、KL2[/COLOR] (2)、KL2[/COLOR] (2)、KL3[/COLOR] (4)。

tc405003

楼主的问题为什么没有解决啊;都盼着有高手能看一下