自制的 建筑工程制图的lsp

angelnoeyeb

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

这个是刚弄的 可以支持图形界面，不过需要安装 opendcl才能运行

nadaloveluna

angelnoeyeb 发表于 2016-10-13 14:48
这个是和二为一的程序，直接布置块参照

嗯，谢谢兄弟的帮助，现在只能看懂LSP，编程功底还不够，现在这个更加实用了，我把它归类到核心筒下梅花形布置桩基的用处了。辛苦了、

angelnoeyeb

你可以试试最后的这个图形界面的，更方便一些，不过需要安装个opendcl

BUBUBA918

建议截面钢筋改成这样

1. (ssget '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")
   
2.                                         (-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>")))

复制代码

另外如何消除重圆？？？如附件

angelnoeyeb

BUBUBA918 发表于 2016-10-16 11:08
建议截面钢筋改成这样

谢谢指点。
重圆我是用的 tssd的消重实体命令。
消重圆程序的话，一直想做，但不太会弄。我考虑了一下，有两个想法：先要判断对象位置接近，然后只算一个，并且将相近位置的从选择集中剔除。或者是建立一个坐标表，每次搜素一遍坐标表，有相近的点就不加入这个表，距离远的加入，最后再统计表中元素。 但感觉需要几重循环，算法不太好。
不太会弄，正好请高手指点一下，给我个好的思路。

angelnoeyeb

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))
)

BUBUBA918

,建议函数放在最前面。另外，能删除重圆吗？

BUBUBA918

这是我用的，不知为和删除不了(90 . 3)重圆？

2. ;删重圆环 明经 ZXQ 2013.8.14 截面钢筋统计
   
3. (setvar "CMDECHO" 0)(princ " \n          删重圆环      截面钢筋统计")
   
4.   (setq ss (ssget '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")
   
5.                                         (-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>"))))
   
6.    (setq n (sslength ss))
   
7.     (setq i -1)
   
8.      (setq en (ssname ss (setq i (1+ i))))
   
9.   (vla-getboundingbox (vlax-ename->vla-object en) 'minpoint 'maxpoint)
   
10.     (setq pmax (vlax-safearray->list maxpoint) pmin (vlax-safearray->list minpoint))
    
11.       (setq ss1 (ssget "C" pmin pmax '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")
    
12.                                                            (-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>"))))
    
13.    (if (> (sslength ss1) 1)
    
14.       (progn
    
15.           (setq ss1 (ssdel en ss1))
    
16.        (setq j -1)
    
17.      (repeat (sslength ss1)
    
18.       (setq en1 (ssname ss1 (setq j (1+ j))))
    
19.       (ssdel en1 ss)
    
20.       (entdel en1)
    
21.          (setq n (sslength ss))
    
22.         )
    
23.       )
    
24.    )
    
25. ;(setq ss (sslength (ssget '((0 . "*polyline") (70 . 1) (90 . 2)))))
    
26.   (setq str (strcat "======截面钢筋根数为：( " (itoa n) " )======"))
    
27.   (princ str)
    
28. )

;删重圆环 明经 ZXQ 2013.8.14 截面钢筋统计<br /> (setvar "CMDECHO" 0)(princ " \n          删重圆环      截面钢筋统计")<br />   (setq ss (ssget '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")<br />                                         (-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>"))))<br />    (setq n (sslength ss))<br />     (setq i -1)<br />      (setq en (ssname ss (setq i (1+ i))))<br />   (vla-getboundingbox (vlax-ename->vla-object en) 'minpoint 'maxpoint)<br />     (setq pmax (vlax-safearray->list maxpoint) pmin (vlax-safearray->list minpoint))<br />       (setq ss1 (ssget "C" pmin pmax '((0 . "LWPOLYLINE")(-4 . "<or")(90 . 2)(90 . 3)(-4 . "or>")<br />                                                            (-4 . "<or")(42 . 1)(42 . -1)(-4 . "or>"))))<br />    (if (> (sslength ss1) 1) <br />       (progn<br />           (setq ss1 (ssdel en ss1)) <br />        (setq j -1)<br />      (repeat (sslength ss1)<br />       (setq en1 (ssname ss1 (setq j (1+ j))))<br />       (ssdel en1 ss)<br />       (entdel en1)<br />          (setq n (sslength ss))<br />         )<br />       )<br />    )<br /> ;(setq ss (sslength (ssget '((0 . "*polyline") (70 . 1) (90 . 2)))))<br />   (setq str (strcat "======截面钢筋根数为：( " (itoa n) " )======"))<br />   (princ str)<br /> )

angelnoeyeb

BUBUBA918 发表于 2016-10-20 20:39
,建议函数放在最前面。另外，能删除重圆吗？

为什么函数要放前边呢？难道和c语言类似？不太明白。可以给解释一下吗？
可以删除，但不完全重叠时可能不是想要的结果