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-13 15:57 编辑
这个是刚弄的 可以支持图形界面，不过需要安装 opendcl才能运行
angelnoeyeb 发表于 2016-10-13 14:48
这个是和二为一的程序，直接布置块参照
嗯，谢谢兄弟的帮助，现在只能看懂LSP，编程功底还不够，现在这个更加实用了，我把它归类到核心筒下梅花形布置桩基的用处了。辛苦了、
你可以试试最后的这个图形界面的，更方便一些，不过需要安装个opendcl
建议截面钢筋改成这样
(ssget '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")
(-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>")))
另外如何消除重圆？？？如附件
BUBUBA918 发表于 2016-10-16 11:08
建议截面钢筋改成这样
谢谢指点。
重圆我是用的 tssd的消重实体命令。
消重圆程序的话，一直想做，但不太会弄。我考虑了一下，有两个想法：先要判断对象位置接近，然后只算一个，并且将相近位置的从选择集中剔除。或者是建立一个坐标表，每次搜素一遍坐标表，有相近的点就不加入这个表，距离远的加入，最后再统计表中元素。 但感觉需要几重循环，算法不太好。
不太会弄，正好请高手指点一下，给我个好的思路。
本帖最后由 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)
)
本帖最后由 angelnoeyeb 于 2016-10-21 09:06 编辑
BUBUBA918 发表于 2016-10-20 20:39
,建议函数放在最前面。另外，能删除重圆吗？
为什么函数要放前边呢？难道和c语言类似？不太明白。可以给解释一下吗？
可以删除，但不完全重叠时可能不是想要的结果