明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4692|回复: 34

[源码] 自制的 建筑工程制图的lsp

  [复制链接]
发表于 2016-10-9 12:58 | 显示全部楼层 |阅读模式
本帖最后由 angelnoeyeb 于 2016-10-25 11:38 编辑

初学lsp 自己写的几个小程序,觉得挺有用,分享一下。也请各位提提建议,以后改进。高手勿嘲

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2016-10-13 14:48 | 显示全部楼层
nadaloveluna 发表于 2016-10-12 09:20
兄弟,你好,用了布置群桩基础的lsp,想到可以结合这个圆替换成块的程序,源程序来自萝卜大神博客,不知道 ...

这个是和二为一的程序,直接布置块参照


(defun c:bzz (/ ww hh mpx mpy px py col raw col_dist raw_dist pta os)
  (setvar "cmdecho" 0)
  (if (= 1 (getreal "\n输入布置方式[三角形(0)/正方形(1)]<0>:"))
    (setq shape 1)
    (setq shape 0)
  )
  (setq z_dist (getreal "\n输入桩间距<1200>:"))
  (if (= z_dist nil)
    (setq z_dist 1200)
  )
  
  (setq en_d (entget (car (entsel "\n选择要布置的块:"))))
  (setq block (cdr (assoc 2 en_d)))

  ;(setq z_dim (getreal "\n输入桩径<400>:"))
  ;(if (= z_dim nil)
  ;  (setq z_dim 400)
  ;)
  (setq pt1 (getpoint "\n输入左下顶点:"))
  (setq pt2 (getpoint "\n输入右上顶点:"))
  (setq ww (abs (- (car pt2) (car pt1))))
  (setq hh (abs (- (cadr pt2) (cadr pt1))))
  (setq mpx (/ (+ (car pt2) (car pt1)) 2))
  (setq mpy (/ (+ (cadr pt2) (cadr pt1)) 2))
  (setq col_dist z_dist)
  (if (= shape 1)
    (setq raw_dist z_dist)
    (setq raw_dist (* (sqrt 3) z_dist))
  )
  (setq col (* (fix (+ (/ ww col_dist 2) 1)) 2))
  ;; (if (= shape 1)
  (setq raw (* (fix (+ (/ hh raw_dist 2) 1)) 2))
  ;; (setq raw (* (fix (+ (/ hh raw_dist 4) 1)) 2))
  ;;)

  (setvar "osmode" (+(getvar "osmode")16384))
  (if (= shape 1)
    (progn
      (setq px (- mpx (* col_dist (/ col 2))))
      (setq py (- mpy (* raw_dist (/ raw 2))))

      (setq pta (list px py))
      (command ".-INSERT" BLOCK "_NON" pta 1 1 0)
      ;(command "circle" pta (/ z_dim 2))
      (command "array"
               (entlast)
               ""
               "r"
               (+ raw 1)
               (+ col 1)
               raw_dist
               col_dist
      )

    )

    (progn
      (setq px (- mpx (* col_dist (/ col 2))))
      (setq py (- mpy (* raw_dist (/ raw 2))))
      (setq pta (list px py))
      (command ".-INSERT" BLOCK "_NON" pta 1 1 0)
      ;(command "circle" pta (/ z_dim 2))
      (command "array"
               (entlast)
               ""
               "r"
               (+ raw 1)
               (+ col 1)
               raw_dist
               col_dist
      )
      (setq px (+ px (/ col_dist 2)))
      (setq py (+ Py (/ raw_dist 2)))
      (setq ptb (list px py))
      
      (command ".-INSERT" BLOCK "_NON" ptb 1 1 0)
      ;(command "circle" ptb (/ z_dim 2))
      (command "array"
               (entlast)
               ""
               "r"
               raw
               col
               raw_dist
               col_dist
      )
    )
  )
  (setvar "osmode" (rem(getvar "osmode")16384))
)
 楼主| 发表于 2016-10-19 00:10 | 显示全部楼层
本帖最后由 angelnoeyeb 于 2016-10-19 21:16 编辑
BUBUBA918 发表于 2016-10-16 11:08
建议截面钢筋改成这样

费了半天劲终于算是搞定了,可以自动忽略特别近的钢筋,这个参数也可以调整 就是mindist。

有个小bug,改正了一下
(vl-load-com)
(defun c:sa (/ i cnt li_pts)
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)

  (setq mindist 30)
  ;;判断为两根钢筋的最小间距
  (setq        ss   (ssget '((0 . "LWPOLYLINE")
                      (-4 . "<OR")
                      (90 . 2)
                      (90 . 3)
                      (-4 . "OR>")
                      (-4 . "<OR")
                      (42 . 1)
                      (42 . -1)
                      (-4 . "OR>")
                     ; (70 . 1)

                     )
             )
        i    1
        j    0
        cnt  0
        ;;计数器
        flag 1
             ;;是否添加的标志
  )
  (if (/= ss nil)
    (progn
      (setq en_d (entget (ssname ss 0)))
      (setq li_pts (cons (getcen en_d) li_pts))
      (setq cnt (1+ cnt))
      (repeat (1- (sslength ss))
        (setq en_d (entget (ssname ss i)))
        (setq pt_tmp (getcen en_d))
        (repeat        (length li_pts)
          ;;li_pts 保存钢筋中心点的list,坐标相同时不重复添加
          (if (< (distance pt_tmp (nth j li_pts)) mindist)
            (setq flag 0)
          )
          (setq j (1+ j))
        )
        (setq j 0)
        (if (= flag 1)
          (progn (setq li_pts (cons pt_tmp li_pts))
                 (setq cnt (1+ cnt))
          )
        )
        (setq flag 1)
        (setq i (1+ i))


      )
    )
  )
  (setq str1 (strcat "======纵筋根数为:( " (itoa cnt) " )======"))
  (princ "\n 重叠钢筋已扣除!\n\n")
  (princ str1)
  (princ)
)
;;计算钢筋的中心位置

(defun getcen (en_d / i pts ang dist)
  (setq i 0)
  (repeat (length en_d)
    (if        (= (car (setq el (nth i en_d))) 10)

      (setq pts (cons (cdr el) pts))

    )
    (SETQ i (1+ i))
  )
  (setq        ang  (angle (car pts) (cadr pts))
        dist (distance (car pts) (cadr pts))
  )
  (polar (car pts) ang (/ dist 2))
)

发表于 2016-10-20 20:49 | 显示全部楼层
这是我用的,不知为和删除不了(90 . 3)重圆?
  1. ;删重圆环 明经 ZXQ 2013.8.14 截面钢筋统计
  2. (setvar "CMDECHO" 0)(princ " \n          删重圆环      截面钢筋统计")
  3.   (setq ss (ssget '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")
  4.                                         (-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>"))))
  5.    (setq n (sslength ss))
  6.     (setq i -1)
  7.      (setq en (ssname ss (setq i (1+ i))))
  8.   (vla-getboundingbox (vlax-ename->vla-object en) 'minpoint 'maxpoint)
  9.     (setq pmax (vlax-safearray->list maxpoint) pmin (vlax-safearray->list minpoint))
  10.       (setq ss1 (ssget "C" pmin pmax '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")
  11.                                                            (-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>"))))
  12.    (if (> (sslength ss1) 1)
  13.       (progn
  14.           (setq ss1 (ssdel en ss1))
  15.        (setq j -1)
  16.      (repeat (sslength ss1)
  17.       (setq en1 (ssname ss1 (setq j (1+ j))))
  18.       (ssdel en1 ss)
  19.       (entdel en1)
  20.          (setq n (sslength ss))
  21.         )
  22.       )
  23.    )
  24. ;(setq ss (sslength (ssget '((0 . "*polyline") (70 . 1) (90 . 2)))))
  25.   (setq str (strcat "======截面钢筋根数为:( " (itoa n) " )======"))
  26.   (princ str)
  27. )
发表于 2016-10-9 17:54 | 显示全部楼层
感谢分享,下来学习下
发表于 2016-10-10 00:06 | 显示全部楼层
同路人,初学就这么牛X
发表于 2016-10-10 03:25 | 显示全部楼层
结构同行呀!
发表于 2016-10-10 11:19 | 显示全部楼层
感谢分享,下来学习下
发表于 2016-10-10 14:49 | 显示全部楼层
感谢分享 看看下来
 楼主| 发表于 2016-10-10 18:17 | 显示全部楼层
freeok 发表于 2016-10-10 00:06
同路人,初学就这么牛X

以后多交流,一起提高
发表于 2016-10-12 09:03 | 显示全部楼层
谢谢同行,哈哈,好几个程序很好用,平时结施图画的,,
发表于 2016-10-12 09:20 | 显示全部楼层
本帖最后由 nadaloveluna 于 2016-10-12 09:22 编辑

兄弟,你好,用了布置群桩基础的lsp,想到可以结合这个圆替换成块的程序,源程序来自萝卜大神博客,不知道你是否能优化下,改成块名或者要替换的块可以自己点取,而不是下面的必须是"TEST"块,不知道行不.
下面是源码:

  1. ;;必须存在TEST这种块,可以结合布桩工具使用
  2. (defun C:YK (/ BLOCK E ELIST N PT SS)
  3.   (princ "\n圆替换成块 作者: 蔡建伟 QQ:9518608 2013年12月11日")
  4.   (setq BLOCK "TEST");_块名
  5.   (if (setq SS (ssget '((0 . "CIRCLE"))))
  6.     (repeat (setq N (sslength SS))
  7.       (setq E (ssname SS (setq N (1- N))))
  8.       (setq ELIST (entget E))
  9.       (setq PT (cdr (assoc 10 ELIST)))
  10.       (command ".-INSERT" BLOCK "_NON" PT 1 1 0)
  11.       (entdel E) ;_删除原圆
  12.     )
  13.   )
  14.   (princ)
  15. )




;;必须存在TEST这种块,可以结合布桩工具使用
(defun C:YK (/ BLOCK E ELIST N PT SS)
  (princ "\n圆替换成块 作者: 蔡建伟 QQ:9518608 2013年12月11日")
  (setq BLOCK "TEST");_块名
  (if (setq SS (ssget '((0 . "CIRCLE"))))
    (repeat (setq N (sslength SS))
      (setq E (ssname SS (setq N (1- N))))
      (setq ELIST (entget E))
      (setq PT (cdr (assoc 10 ELIST)))
      (command ".-INSERT" BLOCK "_NON" PT 1 1 0)
      (entdel E) ;_删除原圆
    )
  )
  (princ)
)

 楼主| 发表于 2016-10-13 14:33 | 显示全部楼层
本帖最后由 angelnoeyeb 于 2016-10-13 14:41 编辑
nadaloveluna 发表于 2016-10-12 09:20
兄弟,你好,用了布置群桩基础的lsp,想到可以结合这个圆替换成块的程序,源程序来自萝卜大神博客,不知道 ...

(defun C:YK (/ BLOCK E ELIST N PT SS)
  (princ "\n圆替换成块 作者: 蔡建伟 QQ:9518608 2013年12月11日")   (setq en_d (entget (car (entsel "\n选择要替换的块:"))))
   (setq block (cdr (assoc 2 en_d)))
;  (setq BLOCK "TEST") ;_块名
  (print 请选择要替换的圆:)
  (if (setq SS (ssget '((0 . "CIRCLE"))))
    (repeat (setq N (sslength SS))
      (setq E (ssname SS (setq N (1- N))))
      (setq ELIST (entget E))
      (setq PT (cdr (assoc 10 ELIST)))
      (command ".-INSERT" BLOCK "_NON" PT 1 1 0)
      (entdel E) ;_删除原圆
    )
  )  (princ)
)

改了一下应该可以满足你的要求了

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 17:13 , Processed in 0.237151 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表