明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 5244|回复: 21

调试申请,程序效果很炫很实用!

    [复制链接]
发表于 2012-8-29 16:35:43 | 显示全部楼层 |阅读模式
本帖最后由 半听可乐 于 2012-9-12 10:11 编辑

论坛里“tjuzkj”朋友分享了下面的程序,对于管道专业很有用,但是本人测试不管用,刚一加载就提示:错误: 输入中的点位置不正确,CAD2004/2008均如此,迫切想要这个程序,希望论坛里的高手能帮帮我!



以下是程序源码

;;By Andrea Andreetti 2008-10-20   ;;
;;       ;;
;;  D R A I N C O N N E C T   ;;
;;         ;;
         ;;
(vl-load-com)
(defun c:DrainConnect (/ dr_sel1 dr_sel1data p1 SDrain_10 SDrain_11)

  
;; Degre to Radian  ;;
      ;;
(defun dtr (a)
  (* pi (/ a 180.0))
)
      ;;
;; Degre to Radian  ;;


  
;; Language Detection      ;;
         ;;
(if (vl-string-search "(FR)" (strcase (ver)))
  (progn
    (setq qstion0 "\nCommande: DrainConnect -Activ?)
    (setq qstion1 "\nD閎ut du Drain: ")
   )
  (progn
    (setq qstion0 "\nCommand: DrainConnect -Activated")
    (setq qstion1 "\nSelect start point of Drain: ")
   )
)
         ;;
;; Language Detection      ;;


;; Selection and Data operation   ;;
         ;;
(setq dr_sel1 nil)
(while (or (= dr_sel1 nil)
           (/= (cdr (assoc 0 (setq dr_sel1data (entget (car dr_sel1))))) "LINE"))
(progn
  (princ qstion1)
  (setq dr_sel1 (entsel))
)
)
(setq p1 (osnap (cadr dr_sel1) "_near"))
(setq SDrain_10 (cdr (assoc 10 dr_sel1data)))
(setq SDrain_11 (cdr (assoc 11 dr_sel1data)))
         ;;
;; Selection and Data operation   ;;

  
  
;; Units detection for ZY and ZY2 variables ;;
         ;;
(if (< (getvar "LUNITS") 3)
  (setq zy 100)
  (setq zy 4)
)
(setq zy2 (/ zy 2))
         ;;
;; Units detection for ZY and ZY2 variables ;;

  
  
;; PREVIEW MODE     ;;
         ;;
(simulDrainAttach)
         ;;
;; PREVIEW MODE     ;;
  
)
         ;;
;;       ;;
;;  D R A I N C O N N E C T   ;;
;;         ;;





;;       ;;
;;    S I M U L D R A I N A T T A C H   ;;
;;         ;;
       ;;
(defun simuldrainattach (/ #elp agp1 pstart1 pstart2 pointtomod ndrainent)

  (while (= (car (setq grr (grread t 2))) 5)
    (redraw)
  (grdraw p1 (polar p1 (dtr 0) zy2) 52 1)
  (grdraw p1 (polar p1 (dtr 45) zy2) 52 1)
  (grdraw p1 (polar p1 (dtr 90) zy2) 52 1)
  (grdraw p1 (polar p1 (dtr 135) zy2) 52 1)
  (grdraw p1 (polar p1 (dtr 180) zy2) 52 1)
  (grdraw p1 (polar p1 (dtr 225) zy2) 52 1)
  (grdraw p1 (polar p1 (dtr 270) zy2) 52 1)
  (grdraw p1 (polar p1 (dtr 315) zy2) 52 1)
    (setq #elp (car (cdr grr)))
    (setq agp1 (inters #elp
                       (polar #elp (+ (angle sdrain_11 sdrain_10) (dtr 90)) 2.0)
                       sdrain_10
                       sdrain_11
                       nil
               )
    )
    (if (not agp1)
      (setq agp1 (inters #elp
                         (polar #elp (+ (angle sdrain_10 sdrain_11) (dtr 90)) 2.0)
                         sdrain_10
                         sdrain_11
                         nil
                 )
      )
    )
    (setq pstart1 (polar agp1 (angle agp1 p1) zy))
    (setq pstart2 (polar agp1 (angle agp1 #elp) zy))
    (grdraw pstart1 pstart2 141 1)
    (grdraw pstart2 #elp 141 1)
  )
  (if (eq (car grr) 3)
    (progn (if (and pstart1 pstart2 #elp)
             (vl-cmdf "._line" pstart1 pstart2 #elp "")
           )
           (redraw)
           (if (not (inters pstart2
                            (polar pstart2
                                   (angle pstart2 pstart1)
                                   (+ (distance pstart2 pstart1) 2)
                            )
                            sdrain_10
                            sdrain_11
                            t
                    )
               )
             (progn (if (< (distance pstart1 sdrain_10)
                           (distance pstart1 sdrain_11)
                        )
                      (setq pointtomod 10)
                      (setq pointtomod 11)
                    )
                    (setq dr_sel1data (subst (cons pointtomod pstart1)
                                           (assoc pointtomod dr_sel1data)
                                           dr_sel1data
                                    )
                    )
                    (setq dr_sel1data (entmod dr_sel1data))
               (setq SDrain_10 (cdr (assoc 10 dr_sel1data)))
               (setq SDrain_11 (cdr (assoc 11 dr_sel1data)))               
             )
           )
           (simuldrainattach)
    )
    (progn (redraw) (exit)(princ))
  )
)
       ;;
;;       ;;
;;    S I M U L D R A I N A T T A C H   ;;
;;         ;;


;;======================================;;
;;  AUTO-LOAD  ;;
;;======================================;;
(princ
qstion0)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

本帖被以下淘专辑推荐:

  • · excel|主题: 80, 订阅: 3
发表于 2012-8-29 16:58:01 | 显示全部楼层
高.实在是高呀
发表于 2012-8-29 22:28:22 | 显示全部楼层
字串出错了。
  1. ;;By Andrea Andreetti 2008-10-20
  2. ;;  D R A I N C O N N E C T
  3. (vl-load-com)
  4. (defun c:DrainConnect (/ dr_sel1 dr_sel1data p1 SDrain_10 SDrain_11)
  5. ;; Degre to Radian
  6. (defun dtr (a) (* pi (/ a 180.0)))
  7. ;; Language Detection
  8. (if (vl-string-search "(FR)" (strcase (ver))) (progn
  9.   (setq qstion0 "\nCommande: DrainConnect -Activated")
  10.   (setq qstion1 "\nD閎ut du Drain: ")
  11. ) (progn
  12.   (setq qstion0 "\nCommand: DrainConnect -Activated")
  13.   (setq qstion1 "\nSelect start point of Drain: ")
  14. ))
  15. ;; Language Detection
  16. ;; Selection and Data operation
  17. (setq dr_sel1 nil)
  18. (while (or (= dr_sel1 nil)
  19.             (/= (cdr (assoc 0 (setq dr_sel1data (entget (car dr_sel1))))) "LINE"))
  20.   (princ qstion1)
  21.   (setq dr_sel1 (entsel))
  22. )
  23. (setq p1 (osnap (cadr dr_sel1) "_near"))
  24. (setq SDrain_10 (cdr (assoc 10 dr_sel1data)))
  25. (setq SDrain_11 (cdr (assoc 11 dr_sel1data)))
  26. ;; Selection and Data operation
  27. ;; Units detection for ZY and ZY2 variables
  28. (if (< (getvar "LUNITS") 3)
  29.   (setq zy 100)
  30.   (setq zy 4)
  31. )
  32. (setq zy2 (/ zy 2))
  33. ;; Units detection for ZY and ZY2 variables ;;
  34. ;; PREVIEW MODE
  35. (simulDrainAttach)
  36. ;; PREVIEW MODE
  37. )
  38. ;;
  39. ;;  D R A I N C O N N E C T
  40. ;;
  41. ;;    S I M U L D R A I N A T T A C H
  42. (defun simuldrainattach (/ #elp agp1 pstart1 pstart2 pointtomod ndrainent)
  43. (while (= (car (setq grr (grread t 2))) 5)
  44.   (redraw)
  45.   (grdraw p1 (polar p1 (dtr 0) zy2) 52 1)
  46.   (grdraw p1 (polar p1 (dtr 45) zy2) 52 1)
  47.   (grdraw p1 (polar p1 (dtr 90) zy2) 52 1)
  48.   (grdraw p1 (polar p1 (dtr 135) zy2) 52 1)
  49.   (grdraw p1 (polar p1 (dtr 180) zy2) 52 1)
  50.   (grdraw p1 (polar p1 (dtr 225) zy2) 52 1)
  51.   (grdraw p1 (polar p1 (dtr 270) zy2) 52 1)
  52.   (grdraw p1 (polar p1 (dtr 315) zy2) 52 1)
  53.   (setq #elp (car (cdr grr)))
  54.   (setq agp1 (inters #elp
  55.                      (polar #elp (+ (angle sdrain_11 sdrain_10) (dtr 90)) 2.0)
  56.                      sdrain_10
  57.                      sdrain_11
  58.                      nil))
  59.   (if (not agp1)
  60.    (setq agp1 (inters #elp
  61.                       (polar #elp (+ (angle sdrain_10 sdrain_11) (dtr 90)) 2.0)
  62.                       sdrain_10
  63.                       sdrain_11
  64.                       nil))
  65.   )
  66.   (setq pstart1 (polar agp1 (angle agp1 p1) zy))
  67.   (setq pstart2 (polar agp1 (angle agp1 #elp) zy))
  68.   (grdraw pstart1 pstart2 141 1)
  69.   (grdraw pstart2 #elp 141 1)
  70. )
  71. (if (eq (car grr) 3) (progn
  72.   (if (and pstart1 pstart2 #elp)
  73.    (vl-cmdf "._line" pstart1 pstart2 #elp "")
  74.   )
  75.   (redraw)
  76.   (if (not (inters pstart2
  77.                    (polar pstart2
  78.                           (angle pstart2 pstart1)
  79.                           (+ (distance pstart2 pstart1) 2)
  80.                    )
  81.                    sdrain_10
  82.                    sdrain_11
  83.                    t)) (progn
  84.    (if (< (distance pstart1 sdrain_10)
  85.           (distance pstart1 sdrain_11)
  86.        )
  87.     (setq pointtomod 10)
  88.     (setq pointtomod 11)
  89.    )
  90.    (setq dr_sel1data (subst (cons pointtomod pstart1)
  91.                             (assoc pointtomod dr_sel1data)
  92.                             dr_sel1data
  93.                      )
  94.    )
  95.    (setq dr_sel1data (entmod dr_sel1data))
  96.    (setq SDrain_10 (cdr (assoc 10 dr_sel1data)))
  97.    (setq SDrain_11 (cdr (assoc 11 dr_sel1data)))               
  98.   ))
  99.   (simuldrainattach)
  100. ) (progn
  101.   (redraw)
  102.   (exit)
  103.   (princ)
  104. ))
  105. )
  106. ;;    S I M U L D R A I N A T T A C H
  107. ;;======================================
  108. ;;  AUTO-LOAD
  109. ;;======================================
  110. (princ qstion0)
 楼主| 发表于 2012-8-29 22:37:53 | 显示全部楼层
ZZXXQQ 发表于 2012-8-29 22:28
字串出错了。

尊敬的ZZXXQQ版主,程序运行效果如图,问题还不少呢

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2012-8-29 23:01:29 | 显示全部楼层
本帖最后由 xshrimp 于 2012-8-29 23:01 编辑

程序不完善,关闭捕捉就好了.
发表于 2012-8-30 09:19:01 | 显示全部楼层
本帖最后由 xshrimp 于 2012-8-30 09:23 编辑

看看程序创意不错.自己写了一个.代码更短.不用关闭捕捉.

源码下载

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2012-8-30 09:52:23 | 显示全部楼层
本帖最后由 半听可乐 于 2012-8-30 09:57 编辑
xshrimp 发表于 2012-8-30 09:19
看看程序创意不错.自己写了一个.代码更短.不用关闭捕捉.

源码下载


哈哈,你效率真高!效果不错,但还有点美中不足:
1.如果连管的顺序是从黄点出发逐渐远离则没问题,如果顺序反过来主管则会被缩短,这不合理(希望修改的不要出现重复线段);
2.倒角产生的那根斜边太短,最好设置成300长(现在是141.4),这是实际需要;
3.连管的末端尚不能实现捕捉,不合理。因为连管必须是指定到卫生器具的特定点上的,没捕捉不行
4.运行中希望能提供一项选择:1.倒角连接(指定300倒角长度)/2.直接45°连接(由鼠标最终确定点画45°直线接到主管上)

希望朋友能完善,过后再给15币!

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2012-8-30 15:08:03 | 显示全部楼层
本帖最后由 xshrimp 于 2012-8-30 15:11 编辑



本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

大侠,实不相瞒我从早上坐等到现在,如大旱盼甘霖啊!  发表于 2012-8-30 15:39
发表于 2012-8-30 15:10:26 | 显示全部楼层


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2012-8-30 15:22:43 | 显示全部楼层
xshrimp 发表于 2012-8-30 15:08

先选择线,然后GRREAD取直线的最近延伸点
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2025-7-15 08:40 , Processed in 0.586567 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表