自制的建筑工程制图的lsp

angelnoeyeb · 发表于 2016-10-9 12:58:28

本帖最后由 angelnoeyeb 于 2016-10-25 11:38 编辑

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

。

angelnoeyeb · 发表于 2016-10-13 14:48:33

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 00:10:17

本帖最后由 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))
)

BUBUBA918 · 发表于 2016-10-20 20:49:40

这是我用的，不知为和删除不了(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)
)

;删重圆环 明经 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) 
)

查无此人咋办 · 发表于 2016-10-9 17:54:07

感谢分享，下来学习下

freeok · 发表于 2016-10-10 00:06:03

同路人，初学就这么牛X

wudechao · 发表于 2016-10-10 03:25:45

结构同行呀!

longer1000 · 发表于 2016-10-10 11:19:25

感谢分享，下来学习下

seaandsky · 发表于 2016-10-10 14:49:40

感谢分享看看下来

angelnoeyeb · 发表于 2016-10-10 18:17:24

freeok 发表于 2016-10-10 00:06
同路人，初学就这么牛X

以后多交流，一起提高

nadaloveluna · 发表于 2016-10-12 09:03:53

谢谢同行，哈哈，好几个程序很好用，平时结施图画的，，

nadaloveluna · 发表于 2016-10-12 09:20:38

本帖最后由 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:33:17

本帖最后由 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)
)

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

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

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

本帖子中包含更多资源

相关帖子

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

本帖子中包含更多资源

相关帖子

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