[分享]： ymxx 的天正建筑II扩展工具集

ymxx · 发表于 2003-11-24 12:09:29

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

使用前提天正3要安装
结构板钢筋画图前提,在天正层配置文件中增加"配筋"和"钢筋"层及颜色,程序会自动建立这两个层
板下部钢筋点轴线,命令为bbbb
板上部钢筋点两点跨过轴线,命令为ccc
另施工图经常改层高等,标高数字每次加减麻烦,本程序因为有个工程正负零变化而做,框选所有标高(自动过滤),会将标高数字自动加减,有用大家拿去试试,很方便,而且标高修改后改了颜色,方便提醒自己改过.命令为vvv
还有个疯狂刷子,有时候方便自己在某个层,某个颜色画图,只要点选已存在的图素,当前层和颜色自动变为点选的这个图素,命令为vv
如果大家喜欢,本人继续努力:)
不用附件,不用积分,欢迎使用,欢迎交流,本人不懂lisp,模仿天正lisp编的,欢迎指教,谢谢!!!
粘贴复制在文本文件(ymxx.lsp)进入天正3后加载,记住天正3,天正5没用过,不爽

(defun c:bbbb (/ p1 p2 a pa pb pc pd t x y x1 y1)
(setq p1 (getpoint "\n请点取下部钢筋起始点 <退出>: "))
(setq p2 (getpoint p1 "\n请点取下部钢筋结束点 <退出>: "))
(setq t (getstring "\n实配钢筋:"))
(setvar "plinewid" 50)
(setq a (angle p1 p2))
(pouts "钢筋")
(setq pb (polar p1 (+ a (/ pi 2)) 120))
(setq pa (polar pb a 240))
(setq pc (polar p2 (+ a (/ pi 2)) 120))
(setq pd (polar pc (- a pi) 240))
(command ".pline" pa pb p1 p2 pc pd "")
(mkstr2)
(setq x (car p1)
y (cadr p1)
x1 (car p2)
y1 (cadr p2)
)
(setq x (/ (+ x x1) 2))
(setq y (/ (+ y y1) 2))
(pouts "配筋")
(command ".text" "bc" (list x y) 250 (* 180.0 (/ a pi)) t)
(mkstr2)
)
(defun c:ccc (/ p1 p2 ss pa pb pc pd paa pbb pcc pdd x y t1 t2)
(setvar "plinewid" 50)
(setq p1 (getpoint "\n请点取上部钢筋起始点 <退出>: "))
(setq p2 (getpoint p1 "\n请点取上部钢筋结束点 <退出>: "))
(setq ss (ssget "F"
(ltoecs (list p1 p2))
(list (cons 8 (parea "*轴线")))
)
)
(transws ss 0)
(slb_slb 0)
(setq pa (gcolor 10)
pb (gcolor 11)
)
(setq pc (inters p1 p2 pa pb nil))
(setq x (getreal "\n左边距离为<1000>: "))
(setq y (getreal "\n右边距离为<1000>: "))
(setq x (if x
x
1000
)
)
(setq y (if y
y
1000
)
)
(setq a (+ (/ (* pi 3) 2) (abs (- (angle pa pb) pi))))
(setq pbb (polar pc (+ a pi) x))
(setq paa (polar pbb (- a (/ pi 2)) 240))
(setq pcc (polar pc a y))
(setq pdd (polar pcc (- a (/ pi 2)) 240))
(pouts "钢筋")
(command ".pline" paa pbb pcc pdd "")
(mkstr2)
(setq t1 (rtos x 2 0)
t2 (rtos y 2 0)
)
(pouts "配筋")
(command ".text"
"m"
(polar paa a (/ x 2))
250
(* 180.0 (/ a pi))
t1
)
(command ".text"
"m"
(polar pdd (+ a pi) (/ y 2))
250
(* 180.0 (/ a pi))
t2
)
(mkstr2)
)
(defun c:vvv (/ ss e a b)
(setq d (getreal "\n请输入要改变的相对标高<-0.2>: "))
(setq d (if d
d
-0.2
)
)
(if (setq ss (ssget '((0 . "TEXT"))))
(progn
(pouts)
(transws ss 0)
(while (and
(setq e (slb_slb 0))
(xdout)
)
(atop e)
(setq a (atof (gcolor 1)))
(setq b (+ a d))
(setq c (rtos b 2 3))
(chslb 62 122)
(chslb 1 c)
(entmod (list (cons -1 e)))
)
(mkstr2)
)
)
(princ)
)
(defun c:vv(/ lay clr cl)
(if (and
(setq e (car (entsel "\n请点击匹配的图层和颜色物体 <退出>: ")))
(atop e)
(setq lay (gcolor 8)
)
)
(progn
(if (setq clr (gcolor 62))
(setq cl (itoa clr))
(setq cl "256")
)
(setvar "clayer" lay)
(setvar "cecolor" cl)
)
)
(princ)
)

(defun c:bbbb (/ p1 p2 a pa pb pc pd t x y x1 y1) 
  (setq p1 (getpoint "\n请点取下部钢筋起始点 <退出>: ")) 
  (setq p2 (getpoint p1 "\n请点取下部钢筋结束点 <退出>: ")) 
  (setq t (getstring "\n实配钢筋:")) 
 
  (setvar "plinewid" 50) 
  (setq a (angle p1 p2)) 
  (pouts "钢筋") 
  (setq pb (polar p1 (+ a (/ pi 2)) 120)) 
  (setq pa (polar pb a 240)) 
  (setq pc (polar p2 (+ a (/ pi 2)) 120)) 
  (setq pd (polar pc (- a pi) 240)) 
  (command ".pline" pa pb p1 p2 pc pd "") 
  (mkstr2) 
  (setq        x  (car p1) 
        y  (cadr p1) 
        x1 (car p2) 
        y1 (cadr p2) 
  ) 
  (setq x (/ (+ x x1) 2)) 
  (setq y (/ (+ y y1) 2)) 
  (pouts "配筋") 
  (command ".text" "bc" (list x y) 250 (* 180.0 (/ a pi)) t) 
  (mkstr2) 
) 
 
 
(defun c:ccc (/ p1 p2 ss pa pb pc pd paa pbb pcc pdd x y t1 t2) 
  (setvar "plinewid" 50) 
  (setq p1 (getpoint "\n请点取上部钢筋起始点 <退出>: ")) 
  (setq p2 (getpoint p1 "\n请点取上部钢筋结束点 <退出>: ")) 
  (setq        ss (ssget "F" 
                  (ltoecs (list p1 p2)) 
                  (list (cons 8 (parea "*轴线"))) 
           ) 
  ) 
  (transws ss 0) 
  (slb_slb 0) 
  (setq        pa (gcolor 10) 
        pb (gcolor 11) 
  ) 
  (setq pc (inters p1 p2 pa pb nil)) 
 
  (setq x (getreal "\n左边距离为<1000>: ")) 
  (setq y (getreal "\n右边距离为<1000>: ")) 
  (setq        x (if x 
            x 
            1000 
          ) 
  ) 
  (setq        y (if y 
            y 
            1000 
          ) 
  ) 
 
  (setq a (+ (/ (* pi 3) 2) (abs (- (angle pa pb) pi)))) 
  (setq pbb (polar pc (+ a pi) x)) 
  (setq paa (polar pbb (- a (/ pi 2)) 240)) 
  (setq pcc (polar pc a y)) 
  (setq pdd (polar pcc (- a (/ pi 2)) 240)) 
  (pouts "钢筋") 
  (command ".pline" paa pbb pcc pdd "") 
  (mkstr2) 
  (setq        t1 (rtos x 2 0) 
        t2 (rtos y 2 0) 
  ) 
  (pouts "配筋") 
  (command ".text" 
           "m" 
           (polar paa a (/ x 2)) 
           250 
           (* 180.0 (/ a pi)) 
           t1 
  ) 
  (command ".text" 
           "m" 
           (polar pdd (+ a pi) (/ y 2)) 
           250 
           (* 180.0 (/ a pi)) 
           t2 
  ) 
  (mkstr2) 
) 
 
(defun c:vvv (/ ss e a b) 
  (setq d (getreal "\n请输入要改变的相对标高<-0.2>: ")) 
  (setq        d (if d 
            d 
            -0.2 
          ) 
  ) 
  (if (setq ss (ssget '((0 . "TEXT")))) 
    (progn 
      (pouts) 
      (transws ss 0) 
      (while (and 
               (setq e (slb_slb 0)) 
               (xdout) 
             ) 
        (atop e) 
        (setq a (atof (gcolor 1))) 
        (setq b (+ a d)) 
        (setq c (rtos b 2 3)) 
        (chslb 62 122) 
        (chslb 1 c) 
 
        (entmod (list (cons -1 e))) 
      ) 
      (mkstr2) 
    ) 
  ) 
  (princ) 
) 
 
(defun c:vv(/ lay clr cl) 
  (if (and 
        (setq e (car (entsel "\n请点击匹配的图层和颜色物体 <退出>: "))) 
        (atop e) 
        (setq lay (gcolor 8) 
              
        ) 
      ) 
 
    (progn 
       
      (if (setq clr (gcolor 62)) 
 
        (setq cl (itoa clr)) 
        (setq cl "256") 
        
        
      ) 
 
      (setvar "clayer" lay) 
      (setvar "cecolor" cl) 
    ) 
  ) 
  (princ) 
)

ymxx · 发表于 2003-11-24 13:01:03

天正3下附加轴线自动修改lisp,前提是天正3环境下,用过天正的都知道,天正附加轴线n/n改后难看死了,还要用天正工具修改一下,本程序就是在天正基础上重新编.命令为fff(大家可以修改此快捷命令)
使用方法,点击要修改的轴线,如果判定为附加轴线会自动按附加轴线图形形成.不用积分,不用下载,*-*5 粘贴在新建文件(ymxx_fjzx.lsp),天正启动后加载.代码如下:

(_@ld "clqlib")
(defun c:fff (/ ss e nb1 nb2 ac n sty cstl str p1 p2 a)
(pouts)
(sndtin)
(while (setq e (car (entsel "\n请点一下要改变编号的轴线号 <退出>: ")))
(atop e)
(if (and
(SETQ str (gcolor 2))
(wcmatch str "_AXISO*")
)
(progn
(setq x (gcolor 41)
la (gcolor 8)
p1 (xdout)
)
(setq
nb1 (gcolor 1)
nb2 (getstring T (strcat "\n轴线编号将改成 <" nb1 ">: "))
)
(if (= "" nb2)
(setq nb2 nb1)
)
(if
;;; (and
(/= "" nb2)
;;; (/= nb1 nb2)
;;; )
(progn
(setq n 1)
(while (> 160
(setq ac (ascii (substr nb2 n)))
0
)
(setq n (1+ n))
)
(if (> ac 160)
(progn
(setq sty "HZ_COMPLEX")
(if (and
(not (tblsearch "style" sty))
(xdin "hztxt.shx")
)
(progn
(if (not _cfgdata)
(progn
(_@ld "loadcfg")
(loadcfg)
)
)
(setq cstl (getvar "textstyle"))
(command ".style"
sty
(strcat (nth 16 _cfgdata) ",hztxt")
""
""
""
""
""
)
(dstop)
(setvar "textstyle" cstl)
)
)
)
(setq sty "COMPLEX")
)
(if (wcmatch nb2 "*/*")
(progn
(setq
p2 (gcolor 11)
h (gcolor 40)
a (angle p1 p2)
ll (axa nb2 "/")
)
(chslb 1 "")
(pouts la)
(command ".insert"
"_axist"
(polar (p_l p1 p2)
(+ a _pi2)
(/ h 2)
)
x
x
(angtos1 a)
(car ll)
(cadr ll)
)
(slb_sld)
)
(chslb 1 nb2 7 sty)
)
(entmod (list (cons -1 e)))
)
)
)
)
)
(mkstr2)
)

(_@ld "clqlib") 
(defun c:fff (/ ss e nb1 nb2 ac n sty cstl str p1 p2 a) 
  (pouts) 
  (sndtin) 
  (while (setq e (car (entsel "\n请点一下要改变编号的轴线号 <退出>: "))) 
    (atop e) 
    (if        (and 
          (SETQ str (gcolor 2)) 
          (wcmatch str "_AXISO*") 
        ) 
      (progn 
 
 
 
        (setq x         (gcolor 41) 
              la (gcolor 8) 
              p1 (xdout) 
        ) 
 
        (setq 
          nb1 (gcolor 1) 
          nb2 (getstring T (strcat "\n轴线编号将改成 <" nb1 ">: ")) 
           
        ) 
        (if (= "" nb2) 
            (setq nb2 nb1) 
        ) 
        (if 
 
;;;          (and 
            (/= "" nb2) 
;;;            (/= nb1 nb2) 
;;;          ) 
           (progn 
             (setq n 1) 
             (while (> 160 
                       (setq ac (ascii (substr nb2 n))) 
                       0 
                    ) 
               (setq n (1+ n)) 
             ) 
             (if (> ac 160) 
               (progn 
                 (setq sty "HZ_COMPLEX") 
                 (if (and 
                       (not (tblsearch "style" sty)) 
                       (xdin "hztxt.shx") 
                     ) 
                   (progn 
                     (if (not _cfgdata) 
                       (progn 
                         (_@ld "loadcfg") 
                         (loadcfg) 
                       ) 
                     ) 
                     (setq cstl (getvar "textstyle")) 
 
                     (command ".style" 
                              sty 
                              (strcat (nth 16 _cfgdata) ",hztxt") 
                              "" 
                              "" 
                              "" 
                              "" 
                              "" 
                     ) 
                     (dstop) 
                     (setvar "textstyle" cstl) 
                   ) 
                 ) 
               ) 
               (setq sty "COMPLEX") 
             ) 
 
             (if (wcmatch nb2 "*/*") 
               (progn 
 
                 (setq 
 
 
                   p2 (gcolor 11) 
                   h  (gcolor 40) 
                   a  (angle p1 p2) 
                   ll (axa nb2 "/") 
 
 
 
                 ) 
                 (chslb 1 "") 
                 (pouts la) 
                 (command ".insert" 
                          "_axist" 
                          (polar (p_l p1 p2) 
                                 (+ a _pi2) 
                                 (/ h 2) 
                          ) 
                          x 
                          x 
                          (angtos1 a) 
                          (car ll) 
                          (cadr ll) 
                 ) 
 
                 (slb_sld) 
               ) 
               (chslb 1 nb2 7 sty) 
             ) 
 
             (entmod (list (cons -1 e))) 
           ) 
        ) 
      ) 
    ) 
  ) 
  (mkstr2) 
 
)

krjcxc321 · 发表于 2004-4-8 15:07:59

我是新手，能否一步一步讲解一下每一步的含义？让我也学学！

wupeiliang · 发表于 2004-7-13 00:48:00

高！水平真高！

行云流水乐呵呵 · 发表于 2004-7-13 18:08:26

谢过了

韦本岗 · 发表于 2004-7-13 18:20:25

为何有些填充图案面积不能求取！！

buildhrcn · 发表于 2004-7-27 18:20:31

谢谢提供.
可以应用...
不过不太常用到

pheniex · 发表于 2004-7-27 21:49:05

谢谢！

ajc2003 · 发表于 2004-8-7 09:02:09

看不懂啊，能否做个现成的！谢谢！

hanjiang37 · 发表于 2006-6-11 17:11:37

恩刚建立了这么个文件还没有试
楼主太厉害了是参照其他程序做出来的么？

jlovel · 发表于 2007-7-4 18:24:59

恩刚建立了这么个文件还没有试
楼主太厉害了是参照其他程序做出来的么？

awfg · 发表于 2007-7-23 11:27:02

不错尝试一下看看好不好用！！

zxdvip · 发表于 2009-3-23 00:15:48

做的不错，天正3又回来了

xuyu · 发表于 2009-3-23 00:33:48

有现成的下载吗

wlwl123123 · 发表于 2009-3-25 16:23:00

用了7年天正3了

账号		自动登录	找回密码
密码			立即注册

[分享]： ymxx 的天正建筑II扩展工具集

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

[分享]：天正附加轴线自动修改lisp