+悬赏：改板配筋，梁柱箍筋功能。

无惢

改板配筋，梁柱箍筋功能：1键改成指定功能lsp。
无论是1，2，3级板筋都指定改成8里的钢筋，如%%1306@100（2），%%13110@100（2）%%13212@100
（2）都能直接改成%%1308@100（2），%%1318@100（2）%%1328@100（2）。
梁柱箍筋类似。最好都整合在一起。

x_s_s_1

无惢 发表于 2013-4-18 20:06
要求达到了，挺好的。还希望改进下。我用其他lsp也类似操作：命令-选择-Esc。没有报错提示啊。。。

命令: hh

选择对象: 指定对角点: 找到 1 个

选择对象: *取消*
; 错误: 函数被取消
我autocad2006没问题，是不是vba的问题啊改成subst试试

2. (defun x_ssn (ss / n lst)
   
3.   (repeat (setq N (sslength ss))
   
4.     (setq LST (cons (ssname SS (setq N (1- N))) LST))
   
5.   )
   
6. )
   
7. (defun c:hh (/ ss ent str en)
   
8.   (while (setq ss (ssget '((0 . "text") (1 . "%%13*`@*"))))
   
9.     (foreach en        (x_ssn ss)
   
10.       (setq ent        (entget en)
    
11.             str        (cdr (assoc 1 ent))
    
12.             ent        (subst
    
13.                   (cons        1
    
14.                         (strcat        (substr str 1 5)
    
15.                                 "8"
    
16.                                 (substr str (1+ (vl-string-search "@" str)))
    
17.                         )
    
18.                   )
    
19.                   (assoc 1 ent)
    
20.                   ent
    
21.                 )
    
22.       )
    
23.       (entmod ent)
    
24.     )
    
25.   )
    
26.   (princ)
    
27. )

(defun x_ssn (ss / n lst)<br />   (repeat (setq N (sslength ss))<br />     (setq LST (cons (ssname SS (setq N (1- N))) LST))<br />   )<br /> )<br /> (defun c:hh (/ ss ent str en)<br />   (while (setq ss (ssget '((0 . "text") (1 . "%%13*`@*"))))<br />     (foreach en        (x_ssn ss)<br />       (setq ent        (entget en)<br />             str        (cdr (assoc 1 ent))<br />             ent        (subst<br />                   (cons        1<br />                         (strcat        (substr str 1 5)<br />                                 "8"<br />                                 (substr str (1+ (vl-string-search "@" str)))<br />                         )<br />                   )<br />                   (assoc 1 ent)<br />                   ent<br />                 )<br />       )<br />       (entmod ent)<br />     )<br />   )<br />   (princ)<br /> )

陨落

这个好做

x_s_s_1

问题表述不清晰，按个人理解写的

2. (defun x_ssn (ss / n lst)
   
3.   (repeat (setq N (sslength ss))
   
4.     (setq LST (cons (ssname SS (setq N (1- N))) LST))
   
5.   )
   
6. )
   
7. (defun c:hh (/ ss obj str en)
   
8.   (while (setq ss (ssget '((0 . "text") (1 . "%%13*`@*"))))
   
9.     (foreach en        (x_ssn ss)
   
10.       (setq obj        (vlax-ename->vla-object en)
    
11.             str        (vla-get-TextString obj)
    
12.       )
    
13.       (vla-put-TextString obj(strcat(substr str 1 5)"8"(substr str (1+(vl-string-search "@" str)))))
    
14.     )
    
15.   )
    
16. )

(defun x_ssn (ss / n lst)<br />   (repeat (setq N (sslength ss))<br />     (setq LST (cons (ssname SS (setq N (1- N))) LST))<br />   )<br /> )<br /> (defun c:hh (/ ss obj str en)<br />   (while (setq ss (ssget '((0 . "text") (1 . "%%13*`@*"))))<br />     (foreach en        (x_ssn ss)<br />       (setq obj        (vlax-ename->vla-object en)<br />             str        (vla-get-TextString obj)<br />       )<br />       (vla-put-TextString obj(strcat(substr str 1 5)"8"(substr str (1+(vl-string-search "@" str)))))<br />     )<br />   )<br /> )

无惢

x_s_s_1 发表于 2013-4-18 11:37
问题表述不清晰，按个人理解写的

hh-选择字体-按ESC。结果报错出现死机。（x_s_s_1,麻烦你在电脑上测试下，按这三个步骤）
我是在测试你的lsp时候，因为无意中选中了文字，而出现这问题的。导致cad重启，挺吓人啊。。。

无惢

x_s_s_1   看看这错误提示，到底是lsp导致，还是我cad问题。

无惢

x_s_s_1 发表于 2013-4-18 11:37
问题表述不清晰，按个人理解写的

要求达到了，挺好的。还希望改进下。我用其他lsp也类似操作：命令-选择-Esc。没有报错提示啊。。。

无惢

x_s_s_1 发表于 2013-4-17 22:55
命令: hh

选择对象: 指定对角点: 找到 1 个

谢谢，挺热心的。效率也高。。。

baiyier1112

先收藏了，慢慢研究