半听可乐 发表于 2012-8-31 11:42:37

大旱盼甘霖,程序盼完善!

本帖最后由 半听可乐 于 2012-12-2 10:02 编辑

社区的朋友“tjuzkj”分享了下面的程序,非常漂亮,最近我在苦想这个程序的作用,结论如下:

布置自动喷淋(管道专业常用)   

程序需改进:①增加动态间距显示(截图中的“主要间距”、“边缘间距”),主要间距默认值为3300,可设置并可记忆上一次输入的主要间距,还可以通过“9” “0”调节,调节的步长值设为50;
                     ②两个边缘间距相同,但是边缘间距跟主要间距不能相同且需要根据主要间距自动调节;
                     ③增加确定第二个点时的捕捉;
                     ④画完水平线能接着画竖线,或者相反
我重点描述一下“拟作用2”,这个管道专业的应该都清楚,布置喷淋时需要叠加梁图,查看喷淋支管与梁、墙、柱子等构配件的间距是否合适,有些建筑的布局较复杂,因此支管间距的反复调整显得非常繁琐,我相信下面的程序经过论坛里大师们恰当的改编,一定能很好的满足上述的功能,这个功能内心早有想法,但苦于没有编程功底,总算是找到个类似的了,仿佛极度口渴时看见一片汪洋大海,是水,但是不能喝!!!小弟在此恭候大师出手相助了!

;;;-------------------------------------------------------------------------------------------------------------------
;;; ★hvlines 动态垂直水平线
;;;Bytjuzkj明经社区分享http://bbs.mjtd.com/thread-91313-1-1.html
;;;-------------------------------------------------------------------------------------------------------------------
(defun c:hvlines ( / *error* g1 g2 gr h l ms p p1 p2 v )
;; Lee Mac 2011
(defun *error* ( m ) (redraw) (princ))
(or *n (setq *n 3))

(if (setq p1 (getpoint "\nSpecify First Corner: "))
    (progn
      (setq ms (princ "\nSpecify Opposite Corner : "))
      (while
      (progn (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr))
          (cond
            ( (= 5 g1)(redraw)
            (if *v
                (progn
                  (setq h (/ (- (car g2) (car p1)) (1+ *n))
                        v (- (cadr g2) (cadr p1))
                        p p1
                  )
                  (repeat *n
                  (setq p (list (+ h (car p)) (cadr p) (caddr p)))
                  (grdraw p (list (car p) (+ v (cadr p)) (caddr p)) -1)
                  )
                  (setq l
                  (list
                      p1 (list (car p1) (+ v (cadr p1)) (caddr p1))
                      g2 (list (+ h (car p)) (cadr p) (caddr p))
                  )
                  )
                )
                (progn
                  (setq h (- (car g2) (car p1))
                        v (/ (- (cadr g2) (cadr p1)) (1+ *n))
                        p p1
                  )
                  (repeat *n
                  (setq p (list (car p) (+ v (cadr p)) (caddr p)))
                  (grdraw p (list (+ (car p) h) (cadr p) (caddr p)) -1)
                  )
                  (setq l
                  (list
                      p1 (list (+ (car p1) h) (cadr p1) (caddr p1))
                      g2 (list (car p) (+ v (cadr p)) (caddr p))
                  )
                  )
                )
            )                  
            (mapcar '(lambda ( a b ) (grdraw a b 1 -1)) l (append (cdr l) (list (car l))))
            )
            ( (= 2 g1)
            (cond
                ( (member g2 '(45 95))
                  (if (= 1 *n)
                  (princ (strcat "\n--> Minimum Number of Lines Reached." ms))
                  (setq *n (1- *n))
                  )
                )
                ( (member g2 '(43 61))
                  (setq *n (1+ *n))
                )
                ( (= 9 g2)
                  (setq *v (not *v)) t
                )
            )
            )
            ( (= 3 g1)
            (if *v
                (progn
                  (setq h (/ (- (car g2) (car p1)) (1+ *n))
                        v (- (cadr g2) (cadr p1))
                  )
                  (repeat *n (setq p1 (list (+ h (car p1)) (cadr p1) (caddr p1)))
                  (entmakex
                      (list
                        (cons 0 "LINE")
                        (cons 10 (trans p1 1 0))
                        (cons 11 (trans (list (car p1) (+ v (cadr p1)) (caddr p1)) 1 0))
                      )
                  )
                  )
                )
                (progn
                  (setq h (- (car g2) (car p1))
                        v (/ (- (cadr g2) (cadr p1)) (1+ *n))
                  )
                  (repeat *n (setq p1 (list (car p1) (+ v (cadr p1)) (caddr p1)))
                  (entmakex
                      (list
                        (cons 0 "LINE")
                        (cons 10 (trans p1 1 0))
                        (cons 11 (trans (list (+ (car p1) h) (cadr p1) (caddr p1)) 1 0))
                      )
                  )
                  )
                )
            )
            nil
            )
          )
      )
      )
    )
)
(redraw) (princ)
)



帖子已经更新,悬赏也提高了,望大师出手相助!(突然发现贴的第二张gif效果出不来,能一并实现更好!)

springwillow 发表于 2012-8-31 11:42:38

本帖最后由 springwillow 于 2012-12-9 20:10 编辑

20楼程序的源码放给大家了。

daidong013 发表于 2012-8-31 12:35:23

缺少捕捉第二点!~~

半听可乐 发表于 2012-8-31 12:47:50

daidong013 发表于 2012-8-31 12:35 static/image/common/back.gif
缺少捕捉第二点!~~

正如我发帖描述

igumu 发表于 2012-8-31 14:31:12

高手

yaokui25 发表于 2012-8-31 23:44:55

缺少捕捉第二点!~~

love12314 发表于 2012-9-1 10:33:44

路过,帮顶

完整武器 发表于 2012-9-1 21:32:13

帮顶 楼主的建议画立杆也不错

yaokui25 发表于 2012-9-3 14:56:18

yaokui25 发表于 2012-8-31 23:44 static/image/common/back.gif
缺少捕捉第二点!~~

这个我下载试用过

longer1000 发表于 2012-9-4 12:39:58

帮顶下!!!!!!!!
页: [1] 2 3 4
查看完整版本: 大旱盼甘霖,程序盼完善!