半听可乐 发表于 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)

357785513 发表于 2012-8-29 16:58:01

高.实在是高呀

ZZXXQQ 发表于 2012-8-29 22:28:22

字串出错了。

;;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)))
;; Language Detection
(if (vl-string-search "(FR)" (strcase (ver))) (progn
(setq qstion0 "\nCommande: DrainConnect -Activated")
(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"))
(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)

半听可乐 发表于 2012-8-29 22:37:53

ZZXXQQ 发表于 2012-8-29 22:28 static/image/common/back.gif
字串出错了。

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

xshrimp 发表于 2012-8-29 23:01:29

本帖最后由 xshrimp 于 2012-8-29 23:01 编辑

程序不完善,关闭捕捉就好了.

xshrimp 发表于 2012-8-30 09:19:01

本帖最后由 xshrimp 于 2012-8-30 09:23 编辑

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

源码下载

半听可乐 发表于 2012-8-30 09:52:23

本帖最后由 半听可乐 于 2012-8-30 09:57 编辑

xshrimp 发表于 2012-8-30 09:19 http://bbs.mjtd.com/static/image/common/back.gif
看看程序创意不错.自己写了一个.代码更短.不用关闭捕捉.

源码下载

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

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

xshrimp 发表于 2012-8-30 15:08:03

本帖最后由 xshrimp 于 2012-8-30 15:11 编辑



xshrimp 发表于 2012-8-30 15:10:26



redcat 发表于 2012-8-30 15:22:43

xshrimp 发表于 2012-8-30 15:08 static/image/common/back.gif


先选择线,然后GRREAD取直线的最近延伸点
页: [1] 2 3
查看完整版本: 调试申请,程序效果很炫很实用!