自制的 建筑工程制图的lsp
本帖最后由 angelnoeyeb 于 2016-10-25 11:38 编辑初学lsp 自己写的几个小程序，觉得挺有用，分享一下。也请各位提提建议，以后改进。高手勿嘲。
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))
)
本帖最后由 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
cnt0
;;计数器
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))
)
这是我用的，不知为和删除不了(90 . 3)重圆？;删重圆环 明经 ZXQ 2013.8.14 截面钢筋统计
(setvar "CMDECHO" 0)(princ " \n 删重圆环 截面钢筋统计")
(setq ss (ssget '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")
(-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>"))))
(setq n (sslength ss))
(setq i -1)
(setq en (ssname ss (setq i (1+ i))))
(vla-getboundingbox (vlax-ename->vla-object en) 'minpoint 'maxpoint)
(setq pmax (vlax-safearray->list maxpoint) pmin (vlax-safearray->list minpoint))
(setq ss1 (ssget "C" pmin pmax '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")
(-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>"))))
(if (> (sslength ss1) 1)
(progn
(setq ss1 (ssdel en ss1))
(setq j -1)
(repeat (sslength ss1)
(setq en1 (ssname ss1 (setq j (1+ j))))
(ssdel en1 ss)
(entdel en1)
(setq n (sslength ss))
)
)
)
;(setq ss (sslength (ssget '((0 . "*polyline") (70 . 1) (90 . 2)))))
(setq str (strcat "======截面钢筋根数为：( " (itoa n) " )======"))
(princ str)
) 感谢分享，下来学习下 同路人，初学就这么牛X 结构同行呀! 感谢分享，下来学习下 感谢分享 看看下来 freeok 发表于 2016-10-10 00:06
同路人，初学就这么牛X
以后多交流，一起提高 谢谢同行，哈哈，好几个程序很好用，平时结施图画的，， 本帖最后由 nadaloveluna 于 2016-10-12 09:22 编辑
兄弟，你好，用了布置群桩基础的lsp，想到可以结合这个圆替换成块的程序，源程序来自萝卜大神博客，不知道你是否能优化下，改成块名或者要替换的块可以自己点取，而不是下面的必须是"TEST"块，不知道行不.
下面是源码：
;;必须存在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)
)
;;必须存在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)
)
本帖最后由 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)
)
改了一下应该可以满足你的要求了