[LISP程序]：风管绘制程序

libo2000

本人学暖通的，花了点时间搞了个风管绘制程序，当是学学auto lisp的实践。
包括风管、大小头、弯头的绘制。
程序有点婆妈！望高手优化优化！！

liuyj

东西不错，不过绘弯头我不知怎么用，好像还出错。不过我还是觉得应该奖积分，很不错的程序。能不能搞个画管端三通，管间四通的程序？这个难度好像比较大，呵呵。

xyzjint_cn

我下载了你的风管程序，里面的风管弯头原型不就是我的吗，我用了一下下，你的捕捉点怎么都改掉了，选了内圆的线后就运行不下去了，而且你加了一个图层，如有2种风管（送风管，回风管甚至更多如排风管，排烟管）如你每一种都在分开的底图上画，那是没问题的，我是在一张底图上全部画出后再根据所要的图纸进行分图的，这样的用你的程序就不能将图纸分开了。

你的风管绘制程序不错，但根据我的绘图习惯，我将风管画在送风管或回风管、排风管图层中，三线风管的中线用兰色点划线，三线风管的2条边线用图层色来画的，法兰是用白色的线，这样在一个图层中用色彩将所有的线都分开了，这样在分图时就不会相同的层了。
现将原有的风管弯头程序上再上载一次.
程序如下：
;;   本软件仅提供作为应用上的参考, 而未声明或隐含任何保证; 对于任何特殊
;;   用途之适应性, 以及商业销售所隐含作出的保证, 在此一概予以否认。
;;;*******************************************单弯头绘制程序***************************************************
(defun C:fgwt (/ ang1 ang2 pd1 pd2 pd3 pd4 pd5 pd6 p1 p2 p3 p4 p5 p6
               int1 int2)
  (princ "\n")
  (princ "************风管单弯头绘制程序************")
  (princ "\n")
  (princ "****版权所有 (C) 2002-1-18  徐跃忠****")
  (princ "\n")
  (princ "*****E-mail:xyzjint_cn@sina.com*****")
  (princ "\n")
  (princ "选择风管管线请从内圆开始方向)")
  (princ "选择主风管管线(从内圆开始方向)")
  (setvar "osmode" 687)

  (setq        pe1 (entsel)                        ;求得主风管管径
        p1  (osnap (last pe1) "nea")
        p2  (getpoint p1)
        p2  (list (car p2) (cadr p2))
        p3x (+ (nth 0 p1) (nth 0 p2))
        p3y (+ (nth 1 p1) (nth 1 p2))
        p3  (list p3x p3y)
        kj  (distance p1 p2)
  )
  (princ "选择支管管线(从内圆开始方向):")
  (setq        pe2 (entsel)
        p4  (osnap (last pe2) "nea")
        p5  (getpoint p4)
        p5  (list (car p5) (cadr p5))
        p6x (+ (nth 0 p4) (nth 0 p5))
        p6y (+ (nth 1 p4) (nth 1 p5))
        p6  (list p6x p6y)

  )
  (setq ln1 (ssget p1))
  (setq ln2 (ssget p2))
  (setq ln4 (ssget p4))
  (setq ln5 (ssget p5))
  (princ "\n选择主风管中心线")
  (setq ln3 (ssget))
  (princ "\n选择支风风管中心线")
  (setq ln6 (ssget))

  (if (= ln1 nil)
    (setq ln1 (ssget))
  )
  (if (= ln2 nil)
    (setq ln2 (ssget))
  )
  (if (= ln3 nil)
    (setq ln3 (ssget))
  )
  (if (= ln4 nil)
    (setq ln4 (ssget))
  )
  (if (= ln5 nil)
    (setq ln5 (ssget))
  )
  (if (= ln6 nil)
    (setq ln6 (ssget))
  )

  (setq kj1 (/ kj 2))
  (setq kj2 (/ (+ kj kj1) 2))
  (command "fillet" "r" kj1)
  (command "fillet" ln1 ln4)
  (setq yh (entlast))

  (command "fillet" "r" kj)
  (command "fillet" ln2 ln5)
  (command "fillet" "r" kj2)
  (command "fillet" ln3 ln6)
  (setvar "osmode" 0)
  (setq ent1 (entget (ssname ln1 0)))
  (setq pc11 (assoc 10 ent1))
  (setq pc11 (list (nth 1 pc11) (nth 2 pc11)))
  (setq pc12 (assoc 11 ent1))
  (setq pc12 (list (nth 1 pc12) (nth 2 pc12)))

  (setq ent2 (entget (ssname ln2 0)))
  (setq pc21 (assoc 10 ent2))
  (setq pc21 (list (nth 1 pc21) (nth 2 pc21)))
  (setq pc22 (assoc 11 ent2))
  (setq pc22 (list (nth 1 pc22) (nth 2 pc22)))

  (setq ent4 (entget (ssname ln4 0)))
  (setq pc41 (assoc 10 ent4))
  (setq pc41 (list (nth 1 pc41) (nth 2 pc41)))
  (setq pc42 (assoc 11 ent4))
  (setq pc42 (list (nth 1 pc42) (nth 2 pc42)))

  (setq ent5 (entget (ssname ln5 0)))
  (setq pc51 (assoc 10 ent5))
  (setq pc51 (list (nth 1 pc51) (nth 2 pc51)))
  (setq pc52 (assoc 11 ent5))
  (setq pc52 (list (nth 1 pc52) (nth 2 pc52)))

  (setq int1 (inters pc11 pc12 pc41 pc42 nil))
  (setq ds1 (distance int1 pc11))
  (setq ds2 (distance int1 pc12))
  (if (< ds1 ds2)
    (setq pd1 pc11)
    (setq pd1 pc12)
  )

  (setq ds3 (distance int1 pc41))
  (setq ds4 (distance int1 pc42))
  (if (< ds3 ds4)
    (setq pd2 pc41)
    (setq pd2 pc42)
  )

  (setq e1 (entget yh))
  (setq c0 (assoc 10 e1))
  (setq c0 (list (nth 1 c0) (nth 2 c0)))
  (setq pd3 (inters c0 pd1 pc21 pc22 nil))
  (setq pd4 (inters c0 pd2 pc51 pc52 nil))
  (command "color" "byblock" "")
  (command "linetype" "s" "bylayer" "")
  (command "line" pd1 pd3 "")
  (command "line" pd2 pd4 "")
  (command "color" "bylayer" "")
  (setvar "osmode" 687)

  (princ)
)

(defun C:fgst ()
  (princ "\n")
  (princ "************风管三通弯头绘制程序************")
  (princ "\n")
  (princ "****版权所有 (C) 2002-1-18  徐跃忠****")
  (princ "\n")
  (princ "*****E-mail:xyzjint_cn@sina.com*****")
  (princ "\n")
  (princ "选择主风管管线")
  (setvar "osmode" 687)
  (setq        pe1 (entsel)                        ;求得主风管管径,取得三个点坐标
        p1  (osnap (last pe1) "nea")
        p2  (getpoint p1)
        p2  (list (car p2) (cadr p2))
        p3  (mapcar '+ p1 p2)
        p3  (mapcar '/ p2 '(2 2 2))
        kj  (distance p1 p2)
  )
  (princ "选择第一支管管线(从内边开始、顺时针方向):")
  (setq        pe2 (entsel)                        ;求得第一支风管,取得三个点坐标
        p4  (osnap (last pe2) "nea")
        p5  (getpoint p4)
        p5  (list (car p5) (cadr p5))
        p6  (mapcar '+ p4 p5)
        p6  (mapcar '/ p6 '(2 2 2))

  )
  (princ "选择第二支管管线(从外边开始、顺时针方向):")
  (setq        pe3 (entsel)                        ;求得第二支风管,取得三个点坐标
        p7  (osnap (last pe3) "nea")
        p8  (getpoint p7)
        p8  (list (car p8) (cadr p8))
        p9  (mapcar '+ p7 p8)
        p9  (mapcar '/ p9 '(2 2 2))
  )
  (setq kj1 (/ kj 2))
  (setq kj2 (/ (+ kj kj1) 2))

  (setq ln1 (ssget p1))
  (setq ln2 (ssget p2))
  (setq ln4 (ssget p4))
  (setq ln5 (ssget p5))
  (setq ln7 (ssget p7))
  (setq ln8 (ssget p8))
  (princ "\n选择主风管中心线")
  (setq ln3 (ssget))
  (princ "\n选择第一支风管中心线")
  (setq ln6 (ssget))
  (princ "\n选择第二支风管中心线")
  (setq ln9 (ssget))
  (if (= ln1 nil)
    (setq ln1 (ssget))
  )
  (if (= ln2 nil)
    (setq ln2 (ssget))
  )
  (if (= ln3 nil)
    (setq ln3 (ssget))
  )
  (if (= ln4 nil)
    (setq ln4 (ssget))
  )
  (if (= ln5 nil)
    (setq ln5 (ssget))
  )
  (if (= ln6 nil)
    (setq ln6 (ssget))
  )
  (if (= ln7 nil)
    (setq ln7 (ssget))
  )
  (if (= ln8 nil)
    (setq ln8 (ssget))
  )
  (if (= ln9 nil)
    (setq ln9 (ssget))
  )
  (setvar "osmode" 0)

  (command "fillet" "r" kj1)
  (command "fillet" ln1 ln8 "")
  (setq yh1 (entlast))
  (command "fillet" ln2 ln4 "")
  (setq yh2 (entlast))
  (command "fillet" ln3 ln5 "")
  (command "fillet" ln3 ln7 "")

  (command "fillet" "r" kj2)
  (command "fillet" ln3 ln6 "")
  (command "fillet" ln3 ln9 "")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq ent1 (entget (ssname ln1 0)))
  (setq pc11 (assoc 10 ent1))
  (setq pc11 (list (nth 1 pc11) (nth 2 pc11)))
  (setq pc12 (assoc 11 ent1))
  (setq pc12 (list (nth 1 pc12) (nth 2 pc12)))

  (setq ent2 (entget (ssname ln2 0)))
  (setq pc21 (assoc 10 ent2))
  (setq pc21 (list (nth 1 pc21) (nth 2 pc21)))
  (setq pc22 (assoc 11 ent2))
  (setq pc22 (list (nth 1 pc22) (nth 2 pc22)))

  (setq ent4 (entget (ssname ln4 0)))
  (setq pc41 (assoc 10 ent4))
  (setq pc41 (list (nth 1 pc41) (nth 2 pc41)))
  (setq pc42 (assoc 11 ent4))
  (setq pc42 (list (nth 1 pc42) (nth 2 pc42)))

  (setq ent5 (entget (ssname ln5 0)))
  (setq pc51 (assoc 10 ent5))
  (setq pc51 (list (nth 1 pc51) (nth 2 pc51)))
  (setq pc52 (assoc 11 ent5))
  (setq pc52 (list (nth 1 pc52) (nth 2 pc52)))

  (setq ent7 (entget (ssname ln7 0)))
  (setq pc71 (assoc 10 ent7))
  (setq pc71 (list (nth 1 pc71) (nth 2 pc71)))
  (setq pc72 (assoc 11 ent7))
  (setq pc72 (list (nth 1 pc72) (nth 2 pc72)))

  (setq ent8 (entget (ssname ln8 0)))
  (setq pc81 (assoc 10 ent8))
  (setq pc81 (list (nth 1 pc81) (nth 2 pc81)))
  (setq pc82 (assoc 11 ent8))
  (setq pc82 (list (nth 1 pc82) (nth 2 pc82)))

  (setq int1 (inters pc11 pc12 pc81 pc82 nil))
  (setq int2 (inters pc21 pc22 pc41 pc42 nil))

  (setq ds1 (distance int1 pc11))
  (setq ds2 (distance int1 pc12))
  (if (< ds1 ds2)
    (setq pd1 pc11)
    (setq pd1 pc12)
  )

  (setq ds3 (distance int2 pc21))
  (setq ds4 (distance int2 pc22))
  (if (< ds3 ds4)
    (setq pd2 pc21)
    (setq pd2 pc22)
  )

  (setq ds5 (distance int2 pc41))
  (setq ds6 (distance int2 pc42))
  (if (< ds5 ds6)
    (setq pd3 pc41)
    (setq pd3 pc42)
  )

  (setq ds7 (distance int1 pc81))
  (setq ds8 (distance int1 pc82))
  (if (< ds7 ds8)
    (setq pd4 pc81)
    (setq pd4 pc82)
  )

  (setq e1 (entget yh1))
  (setq c0 (assoc 10 e1))
  (setq e2 (entget yh2))
  (setq c1 (assoc 10 e2))
  (setq c0 (list (nth 1 c0) (nth 2 c0)))
  (setq c1 (list (nth 1 c1) (nth 2 c1)))

  (setq pd5 (inters c1 pd3 pc51 pc52 nil))
  (setq pd6 (inters c0 pd4 pc71 pc72 nil))
  (command "color" "byblock" "")
  (command "linetype" "s" "bylayer" "")

  (command "line" pd1 pd2 "")
  (command "line" pd3 pd5 "")
  (command "line" pd4 pd6 "")

  (command "color" "bylayer" "")
  (setvar "osmode" 687)

  (princ)

)

dwgplt

风管三通弯头绘制程序不清楚怎么用，能做一个演示动画吗？
你们的程序很好用，谢谢！！

libo2000

to xyzjint_cn:
你的弯头程序开始我不是很习惯，老出错－－呵呵，太笨了我！所以改成自己的习惯了。
另外我觉得弯头应该可以自定义弯头的弯曲曲率要好点，毕竟不是所有的地方都一样的，有些弯曲过小风阻太大，而且制作不便。
要是能自动判断风管的内外圆管线就好了：
＝＝＝》》
;ln1,ln4风管中心线
;ln2.ln3风管1的上下线
;ln5,ln6风管2的上下线
    ;;;;;;;ln2 ln5交点p25与ln3 ln6交点p36的连线为 ln2536，p21 p51的连线为 ln25，
    ;;;;;;;;当ln2 ln5分别在ln3 ln6上部，并且ln2536与ln25垂点在p25的上部，则ln2 ln5为内圆；
    ;;;;;;;;当ln2 ln5分别在ln3 ln6下部，并且ln2536与ln25垂点在p36的下部，则ln2 ln3为内圆。
    ;;;其他情况ln2 ln5为外圆
《《＝＝
xyzjint_cn兄认为这样判断正确否？
您说cheng_wt绘制错误，具体原因我不得而知，如果你用cheng_fg绘制两个风管再执行cheng_wt无错误阿！－－我测试N遍才上传的。

至于您说的图层问题可以加个全程变量cheng_fg_layer来解决。



to liuyj ：弯头绘制错误，主要是选择风管线次序不对；
内圆线段是指绘弯头时候
"FILLET"指令设定“Polyline/Radius/Trim/《Select first object》: r”
时候值最小的那个“Enter fillet radius 《0》:”
==>>修改
;*******************************************单弯头绘制程序*********************************************
(defun C:cheng_wt (/ ang1 ang2 pd1 pd2 pd3 pd4 pd5 pd6 p1 p2 p3 p4 p5 p6 ln1 ln2 ln3 ln4 ln5 ln6 int1 int2 old_osmode old_clayer old_cecolor rr)
  (princ "****盗版自 徐跃忠****")
  (princ "\n************内圆管线就是小弯头的那个************")
  (setq old_osmode (getvar "osmode"))
  (setq old_clayer (getvar "clayer"))
  (setq pe1 (entsel "\n选择主风管内圆部分的管线： "))                        ;求得主风管管径
  (if pe1
    (setq
        p1  (osnap (last pe1) "nea")
        p2  (getpoint p1)
        p2  (list (car p2) (cadr p2))
        p3x (+ (nth 0 p1) (nth 0 p2))
        p3y (+ (nth 1 p1) (nth 1 p2))
        p3  (list p3x p3y)
        kj  (distance p1 p2)
        old_cecolor (getvar "cecolor")
    )
  )
  (if pe1 (setq pe2 (entsel "\n选择支风管内圆部分的管线： ")))
  (if pe2
    (setq
        p4  (osnap (last pe2) "nea")
        p5  (getpoint p4 "\n选择支风管外圆部分的管线： ")
        p5  (list (car p5) (cadr p5))
        p6x (+ (nth 0 p4) (nth 0 p5))
        p6y (+ (nth 1 p4) (nth 1 p5))
        p6  (list p6x p6y)
    )
  )
  (if (and pe1 pe2)
    (progn
      (setq ln1 (ssget p1))
      (setq ln2 (ssget p2))
      (setq ln4 (ssget p4))
      (setq ln5 (ssget p5))
      (while (= ln3 nil) (setq ln3 (entsel "\n选择主风管中心线")) )
      (while (= ln6 nil) (setq ln6 (entsel "\n选择支风管中心线")) )
      (if (= ln1 nil)
        (setq ln1 (entsel))
      )
      (if (= ln2 nil)
        (setq ln2 (entsel))
      )
      (if (= ln3 nil)
        (setq ln3 (entsel))
      )
      (if (= ln4 nil)
        (setq ln4 (entsel))
      )
      (if (= ln5 nil)
        (setq ln5 (entsel))
      )
      (if (= ln6 nil)
        (setq ln6 (entsel))
      )
    (setq rr (getreal "\n弯头曲率<1.25>:"))
    (if (= nil rr) (setq rr 1.25))
      (setq kj1 (/ kj 2))
      (setq kj2 (/ (+ kj kj1) 2))
      (command "fillet" "r" (* kj1 rr))
      (command "fillet" ln1 ln4)
      (setq yh (entlast))
   
      (command "fillet" "r" (* kj rr))
      (command "fillet" ln2 ln5)
      (command "fillet" "r" (* kj2 rr))
      (command "fillet" ln3 ln6)
      (setvar "osmode" 0)
      (setq ent1 (entget (ssname ln1 0)))
      (setq pc11 (assoc 10 ent1))
      (setq pc11 (list (nth 1 pc11) (nth 2 pc11)))
      (setq pc12 (assoc 11 ent1))
      (setq pc12 (list (nth 1 pc12) (nth 2 pc12)))
   
      (setq ent2 (entget (ssname ln2 0)))
      (setq pc21 (assoc 10 ent2))
      (setq pc21 (list (nth 1 pc21) (nth 2 pc21)))
      (setq pc22 (assoc 11 ent2))
      (setq pc22 (list (nth 1 pc22) (nth 2 pc22)))
   
      (setq ent4 (entget (ssname ln4 0)))
      (setq pc41 (assoc 10 ent4))
      (setq pc41 (list (nth 1 pc41) (nth 2 pc41)))
      (setq pc42 (assoc 11 ent4))
      (setq pc42 (list (nth 1 pc42) (nth 2 pc42)))
   
      (setq ent5 (entget (ssname ln5 0)))
      (setq pc51 (assoc 10 ent5))
      (setq pc51 (list (nth 1 pc51) (nth 2 pc51)))
      (setq pc52 (assoc 11 ent5))
      (setq pc52 (list (nth 1 pc52) (nth 2 pc52)))
   
      (setq int1 (inters pc11 pc12 pc41 pc42 nil))
      (setq ds1 (distance int1 pc11))
      (setq ds2 (distance int1 pc12))
      (if (< ds1 ds2)
        (setq pd1 pc11)
        (setq pd1 pc12)
      )
   
      (setq ds3 (distance int1 pc41))
      (setq ds4 (distance int1 pc42))
      (if (< ds3 ds4)
        (setq pd2 pc41)
        (setq pd2 pc42)
      )
      (setq e1 (entget yh))
      (setq c0 (assoc 10 e1))
      (setq c0 (list (nth 1 c0) (nth 2 c0)))
      (setq pd3 (inters c0 pd1 pc21 pc22 nil))
      (setq pd4 (inters c0 pd2 pc51 pc52 nil))
      (command ".layer" "m" "Cheng_FG" "")
      (setvar "clayer" "Cheng_FG")      
      (setvar "cecolor" "2")
      (command "line" pd1 pd3 "")
      (command "line" pd2 pd4 "")
    );endprogn
  );endif pe1 pe2
  (setvar "osmode" old_osmode)
  (setvar "clayer" old_clayer)
  (setvar "cecolor" old_cecolor)
  (princ)
)

==<<

徐兄的弯头绘制程序操作次序同盗版程序一样：先选择风管1的内圆管线、外圆管线，再选择风管2的内圆、外圆管线。最后选择风管1、风管2的中心线。

htm

不错的东西，有空我们多多交流，我也是搞暖通的。