画两个圆的外共切线的程序申请

chamous

做传动设计时,常用到带传动及链传动.这时需要计算出链条或皮带的长度,如果能有一个程序,只要选择两个圆(已知的分度圆),CAD就可以用多段线自动画出带两条外共切线的链条或皮带轨迹,这样就会大大减少画图的时间.

小弟正在学LISP,现在向各位高手请教,相信不久的将来就是我向本论坛做贡献的时候了.

wangzhong

画一个简单的图传上来,此问题容易?

chamous

感谢二楼大哥相助

相关图片如下,是BMP格式的.

设计时,往往一对传动轮(的分度圆)的空间位置先确定,然后画出传动带/链的运行轨迹,如果这个运行轨迹是一条封闭多段线的话,可直接用CAD查询工具得到轨迹线的长度.这样会很方便.一般方法是画出两个圆的外共切线,然后用多段线沿带或链的轨迹画一条多段线,这样费时也会有线重迭,增加CAD的占用空间.

希望用LISP得到这样一个功能:命令——点选两个已知圆（一对传动轮的分度圆），结果：自动沿两个圆的的外沿画一条封闭的多段线。该多段线包含两个圆弧，两个圆弧分别与已知的两个圆（部分）重迭；还包含两条直线，分别与两个圆外切。

wangzhong

把源代码传来,使用说明:

得到第一条切线后.用MIRROR命令得到另一条切线

有问题反馈!

(DEFUN C:TAN( / ypd c1 c2 entlist entlist1 cout bj1 bj2 bj3
        ss sss pt1 pt2 pt3 pt4 ang1 ang2 ss1 xx )
           (setvar "osmode" 0)
           (setq ypd (getstring "\n切线在两圆同侧dd/切线穿过两圆cc/:")) 
           (setq c1 (entsel "\n选择第一个园:"))
           (setq c2 (entsel "\n选择第二个园:"))
           (setq entlist (entget (car c1)))
           (setq entlist1 (entget (car c2)))
           (setq cont 0)
           (while (/= (car (nth cont entlist)) 210)
                      (setq nlist (nth cont entlist))
               (if (= (car nlist) 40)
                             (setq bj1 (cdr nlist))
        ) 
   
                      (if (= (car nlist) 10)
                             (setq pt1 (cdr nlist))                      
                      )
                      (setq cont (+ cont 1))
           )
           (setq cont 0)
           (while (/= (car (nth cont entlist1)) 210)
                      (setq nlist (nth cont entlist1))
                      (if (= (car nlist) 40)
                             (setq bj2 (cdr nlist))
        )    
                      (if (= (car nlist) 10)
                             (setq pt2 (cdr nlist))                      
                      )
                      (setq cont (+ cont 1))
           )
           (command "pline" pt1 pt2 "")
           (setq ss (distance pt1 pt2))
           (if (or (= "dd" ypd)(= "DD" ypd))
               (progn
                    (setq bj3 (abs (- bj1 bj2)))
                    (setq ss1 (sqrt (- (* ss ss) (* bj3 bj3))))
                    (setq ang1 (atan ss1 bj3))
                    (setq ang2 (angle pt1 pt2))
                    (setq pt3 (polar pt1 (+ ang2 ang1) bj1))
                    (setq pt4 (polar pt2 (angle pt1 pt3) bj2))

               )
    )
           (if (or (= "cc" ypd)(= "CC" ypd))
               (progn
      (setq xx (/ (* ss bj2) (+ bj1 bj2)))
      (setq sss (- ss xx))
                    (setq ss1 (sqrt (- (* sss sss) (* bj1 bj1))))
                    (setq ang1 (atan ss1 bj1))
                    (setq ang2 (angle pt1 pt2))
                    (setq pt3 (polar pt1 (+ ang2 ang1) bj1))
                    (setq pt4 (polar pt2 (angle pt3 pt1) bj2))
               )
           ) 
           (command "pline" pt3 pt4 "")
           (princ)
)

sailorcwx

我也发一个

(defun c:cs ( / YH_A YH_ANGLE0 YH_ANGLE1 YH_ANGLE2 YH_B YH_C YH_CIRCLE1 YH_CIRCLE1_C YH_CIRCLE1_R YH_CIRCLE2 YH_CIRCLE2_C YH_CIRCLE2_R YH_POINT1 YH_POINT2)
  (setq YH_circle1 (entsel "\n\n选择第一个圆"))
  (setq YH_circle2 (entsel "\n\n选择第二个圆"))
  (if (and (/= YH_circle1 nil) (/= YH_circle2 nil) (= (cdr (assoc 0 (entget (car YH_circle1)))) "CIRCLE")(= (cdr (assoc 0 (entget (car YH_circle1)))) "CIRCLE"))
    (progn
  (setq YH_circle1_c (cdr (assoc 10 (entget (car YH_circle1))))
 YH_circle2_c (cdr (assoc 10 (entget (car YH_circle2))))
 YH_circle1_r (cdr (assoc 40 (entget (car YH_circle1))))
 YH_circle2_r (cdr (assoc 40 (entget (car YH_circle2))))
 )
  (setq YH_c (distance YH_circle1_c YH_circle2_c))
  (setq YH_b (abs (- YH_circle1_r YH_circle2_r)))
  (setq YH_a (sqrt (+ (EXPT YH_c 2) (EXPT YH_b 2))))
  (if (/= YH_b 0) (setq YH_angle0 (atan (/ YH_a YH_b))) (setq YH_angle0 (/ pi 2)))
  (setq YH_angle1 (angle YH_circle1_c YH_circle2_c))
  (setq YH_angle2 (+ YH_angle0 YH_angle1))
  (if (< YH_angle2 pi) (setq YH_angle2 (+ YH_angle2 pi)))
  (setq YH_point1 (polar YH_circle1_c YH_angle2 YH_circle1_r))
  (setq YH_point2 (polar YH_circle2_c YH_angle2 YH_circle2_r))
  (command "line" YH_point1 YH_point2 "")
  (command "mirror" (entlast) "" YH_circle1_c YH_circle2_c "N")
  )
    (alert "选择错误,必须选择两个圆！")
    )
  (princ)
  )

wangzhong

你这个不是圆切线是割线!!!!!!!!!!!!!!!

sailorcwx

是切线，不过忘记把捕捉关了 .改进了一下，刚才只看图没看要求

(defun c:cs ( / YH_ANGLE3 YH_OSMODE YH_POINT3 YH_POINT4 YH_A YH_ANGLE0 YH_ANGLE1 YH_ANGLE2 YH_B YH_C YH_CIRCLE1 YH_CIRCLE1_C YH_CIRCLE1_R YH_CIRCLE2 YH_CIRCLE2_C YH_CIRCLE2_R YH_POINT1 YH_POINT2)
  (setq YH_osmode (getvar "osmode"))
  (setvar "osmode" 0)
  (setq YH_circle1 (entsel "\n\n选择第一个圆"))
  (setq YH_circle2 (entsel "\n\n选择第二个圆"))
  (if (and (/= YH_circle1 nil) (/= YH_circle2 nil) (= (cdr (assoc 0 (entget (car YH_circle1)))) "CIRCLE")(= (cdr (assoc 0 (entget (car YH_circle1)))) "CIRCLE"))
    (progn
  (setq YH_circle1_c (cdr (assoc 10 (entget (car YH_circle1))))
 YH_circle2_c (cdr (assoc 10 (entget (car YH_circle2))))
 YH_circle1_r (cdr (assoc 40 (entget (car YH_circle1))))
 YH_circle2_r (cdr (assoc 40 (entget (car YH_circle2))))
 )
  (setq YH_c (distance YH_circle1_c YH_circle2_c))
  (setq YH_b (abs (- YH_circle1_r YH_circle2_r)))
  (setq YH_a (sqrt (- (EXPT YH_c 2) (EXPT YH_b 2))))
  (if (/= YH_b 0) (setq YH_angle0 (atan (/ YH_a YH_b))) (setq YH_angle0 (/ pi 2)))
  (setq YH_angle1 (angle YH_circle1_c YH_circle2_c))
  (setq YH_angle2 (+ YH_angle0 YH_angle1))
 
  (if (<= YH_angle2 pi) (setq YH_angle2 (+ YH_angle2 pi)))
   (setq YH_angle3 (- YH_angle2 YH_angle0  YH_angle0))
  (setq YH_point1 (polar YH_circle1_c YH_angle2 YH_circle1_r))
  (setq YH_point2 (polar YH_circle2_c YH_angle2 YH_circle2_r))
  (setq YH_point3 (polar YH_circle1_c YH_angle3 YH_circle1_r))
  (setq YH_point4 (polar YH_circle2_c YH_angle3 YH_circle2_r))
  (command "pline" YH_point1 YH_point2 "a" YH_point4 "L" YH_point3 "a" YH_point1 "CL")
  )
    (alert "选择错误,必须选择两个圆！")
    )
  (setvar "osmode" YH_osmode)
  (princ)
  )

sailorcwx

仔细测试了一下，确实有点问题，呵呵

chamous

谢谢上面各位大哥抽空为我编写程序,我会仔细研习你们的程序!

小弟的邮件:chenw@gangxing.com

可用MSN即时通讯.

yshf

;两圆的外公切线
(defun c:cc()
   (setq xtblm '("cmdecho" "osmode")
  xtblz (mapcar 'getvar xtblm)
   )
   (mapcar 'setvar xtblm '(0 0))
   (while (progn (setq en1 (entsel "\n请选取第一个圆:"))
          (not (if (= en1 nil)
           nil
                  (= (cdr (assoc 0 (entget (car en1)))) "CIRCLE"))
   )
   )
          (princ "\n你选取的不是圆或者未选取任何图元，请重新选取第一个圆！")
   )
   (while (progn (setq en2 (entsel "\n请选择第二个圆:"))
          (not (if (= en2 nil)
           nil
                  (= (cdr (assoc 0 (entget (car en2)))) "CIRCLE"))
   )
   )
          (princ "\n你选取的不是圆或者未选取任何图元，请重新选取第二个圆！")
   )
   (setq db1 (entget (car en1))
  o1 (cdr (assoc 10 db1))
  r1 (cdr (assoc 40 db1))
  db2 (entget (car en2))
  o2 (cdr (assoc 10 db2))
  r2 (cdr (assoc 40 db2))
   )
   (if (< r1 r2)
       (progn
          (setq oc o1  o1 o2  o2 oc
  oc r1  r1 r2  r2 oc
   )
       )
   )
   (setq dr (- r1 r2)  ang (angle o1 o2)  dd (distance o1 o2)
  b  (- (* 0.5 pi) (atan (/ dr (sqrt (- (* dd dd) (* dr dr))))))
   )
   
   (command "_line" (polar o1 (+ ang b) r1) (polar o2 (+ ang b) r2) ""
            "_line" (polar o1 (- ang b) r1) (polar o2 (- ang b) r2) ""
   )
   (mapcar 'setvar xtblm xtblz)(princ)
)