设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [试用]：求过一点并且与两直线相切的圆(源码) ...
返回列表 发新帖
查看: 681|回复: 3

[试用]：求过一点并且与两直线相切的圆(源码)

[复制链接]
xiao_longxin

已领礼包: 3个

财富等级: 恭喜发财
发表于 2005-6-4 14:15:54 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
求过一点并且与两直线相切的圆
这里使用了一个明经上mccad写的一个曲线相交求交点的函数，在下面可以下载到的。因为是别人写的，我没有公布源码，请见谅。


  4. ;;By Xiao_longxin
  5. ;;e1_star  e1_end 第一条直线起、点
  6. ;;e2_star  e2_end 第二条直线起、点
  7. ;;pt 要求的相切圆上的一点

  9. ;;返回：
  10. ;;（(圆心坐标) 半径　(圆心坐标) 半径）

  12. (defun errexit (s)
  13.   (princ "\nError:  ")
  14.   (princ s)
  15. )

  17. (defun onepo_twoline_qieyuan (           e1_star    e1_end
  18.                                 e2_star           e2_end     pt /
  19.                                 oldcmdecho　oldosmode setp　ang1
  20.                                 ang1_cz           ang2              ang2_cz
  21.                                 ang           ang2_      ang1_
  22.                                 e1_e2　e1_e2_gx              pt_e1
  23.                                 pt_e2           jd              p1
  24.                                 p2           p3              dist
  25.                                 dist1           dist2      p4
  26.                                 cr_list           cr_pt      cr_r
  27.                                 ent           pfx              pfx_cz
  28.                                 jd_list           e1              e2
  29.                                )

  31.   ;;(setq e1_star (getpoint))
  32.   ;;(setq e1_end (getpoint))
  33.   ;;(setq e2_star (getpoint))
  34.   ;;(setq e2_end (getpoint))
  35.   ;;(setq pt (getpoint))
  36.   ;;(command "point" pt)
  37.   ;;(command "pline" e1_star e1_end "")
  38.   ;;(command "pline" e2_star e2_end "")

  40.   (setq oldcmdecho (getvar "cmdecho"))
  41.   (setvar "cmdecho" 0)
  42.   (setq oldosmode (getvar "osmode"))
  43.   (setvar "osmode" 0)
  44.   (setq setp 0.000000005)                ;设置允许的误差

  46.   (setq ang1 (angle e1_star e1_end))        ;直线1的方位角
  47.   (setq ang1_cz (+ ang1 (/ pi 2)))
  48.   (setq ang2 (angle e2_star e2_end))        ;直线2的方位角
  49.   (setq ang2_cz (+ ang2 (/ pi 2)))
  50.   　
  51.   (setq ang (angle e1_star e2_end))


  54.                                         ;分别判断2条直线之间是否平行
  55.   (if (or (< (abs (- ang1 ang2)) setp)
  56.           (and (< (abs (- ang1 ang2)) (+ pi setp))
  57.                                         ;2条直线平行允许有一定的误差
  58.                (> (abs (- ang1 ang2)) (- pi setp))
  59.           )
  60.       )
  61.     (setq e1_e2 t)
  62.     (setq e1_e2 nil)
  63.   )

  65.   　
  66.   ;;判断e1 e2是否是同一条直线
  67.   (if (and e1_e2
  68.            (or (< (abs (- ang1 ang)) setp)
  69.                (and (< (abs (- ang1 ang)) (+ pi setp))
  70.                                         ;2条直线平行允许有一定的误差
  71.                     (> (abs (- ang1 ang)) (- pi setp))
  72.                )
  73.            )
  74.       )
  75.     (setq e1_e2_gx t)
  76.     (setq e1_e2_gx nil)
  77.   )

  79.   ;;求p1点与直线的垂距，以此判断是否在直线上
  80.   (setq p1 (polar pt ang1_cz 100))
  81.   (setq p1 (inters e1_star e1_end p1 pt nil))
  82.   (setq ang1_ (angle p1 pt))
  83.   (setq dist1 (distance p1 pt))
  84.   (if (< dist1 0.0001)
  85.     (setq pt_e1 t)
  86.     (setq pt_e1 nil)
  87.   )
  88.   ;;求p2点与直线的垂距，以此判断是否在直线上
  89.   (setq p2 (polar pt ang2_cz 100))
  90.   (setq p2 (inters e2_star e2_end p2 pt nil))
  91.   (setq dist2 (distance p2 pt))
  92.   (setq ang2_ (angle p2 pt))
  93.   (if (< dist2 0.0001)
  94.     (setq pt_e2 t)
  95.     (setq pt_e2 nil)
  96.   )

  98.   (cond
  99.     ((and (and (< (abs (- ang1_ ang2_)) 0.000000001) e1_e2)
  100.           (not e1_e2_gx)
  101.      )                                        ;点在两平行线的一边
  102.      (prompt "\n点在两平行线的一边，没有切圆")
  103.      (setq cr_list nil)
  104.     )
  105.     ((and e1_e2_gx (or pt_e1 pt_e2))        ;两线共一且点在线上
  106.      (prompt "\n两线共一且点在线上，没有切圆")
  107.      (setq cr_list nil)
  108.     )
  109.     ((and e1_e2_gx (and (not pt_e1) (not pt_e2))) ;两线共线且点不在线上
  110.      (setq cr_r (/ dist1 2))
  111.      (setq cr_pt (polar p1 ang1_ cr_r))
  112.      ;;(command "._circle" cr_pt cr_r)
  113.      (setvar "cmdecho" oldcmdecho)
  114.      (setvar "osmode" oldosmode)
  115.      (setq cr_list (list cr_pt cr_r))
  116.     )
  117.     (e1_e2                                ;两线平行
  118.      (if (or pt_e1 pt_e2)                ;且有点在线上
  119.        (progn
  120.          (setq p1 (polar pt ang1_cz 100))
  121.          (setq p2 (inters e2_star e2_end pt p1 nil))
  122.          (setq p1 (inters e1_star e1_end pt p1 nil))
  123.          (setq cr_r (/ (distance p1 p2) 2))
  124.          (setq cr_pt (polar p1 (angle p1 p2) cr_r))
  125.          ;;(command "._circle" cr_pt cr_r)
  126.          (setvar "cmdecho" oldcmdecho)
  127.          (setvar "osmode" oldosmode)
  128.          (setq cr_list (list cr_pt cr_r))
  129.        )
  130.        (progn                                ;点不在线上
  131.          (setq p1 (polar e1_star ang1_cz 100))
  132.          (setq p1 (inters e2_star e2_end e1_star p1 nil))
  133.          (setq cr_r (/ (distance p1 e1_star) 2))
  134.          (setq p2 (polar e1_star (angle e1_star p1) cr_r))
  135.          (setq p1 (polar p2 ang1 100))
  136.          (setq p3 (polar pt ang1_cz 100))
  137.          (setq p3 (inters p1 p2 p3 pt nil))
  138.          (setq dist (distance p3 pt))
  139.          (setq dist (sqrt (- (* cr_r cr_r) (* dist dist))))
  140.          (setq cr_pt (polar p3 ang1 dist))
  141.          ;;(command "._circle" cr_pt cr_r)
  142.          (setq cr_list (list cr_pt cr_r))
  143.          (setq cr_pt (polar p3 (+ pi ang1) dist))
  144.          ;;(command "._circle" cr_pt cr_r)
  145.          (setvar "cmdecho" oldcmdecho)
  146.          (setvar "osmode" oldosmode)
  147.          (setq cr_list (append cr_list (list cr_pt cr_r)))
  148.        )
  149.      )
  150.     )                                        ;end 两线平行
  151.     (t                                        ;两线不平行
  152.      (setq jd (inters e1_star e1_end e2_star e2_end nil))
  153.      (setq dist (distance pt jd))
  154.      (cond
  155.        ((< dist 0.0001)                        ;两线不平行且点在线e1、e2交点上
  156.         (prompt "\n点在两线的交点上，没有切圆")
  157.         (setq cr_list nil)
  158.        )
  159.        (pt_e1                                ;两线不平行且点在线e1上
  160.         (setq p1 (polar pt ang1_cz 100))
  161.         (setq p2 (polar jd ang2 dist))
  162.         (setq p3 (polar p2 ang2_cz 100))
  163.         (setq cr_pt (inters p1 pt p2 p3 nil))
  164.         (setq cr_r (distance cr_pt pt))
  165.         ;;(command "._circle" cr_pt pt)
  166.         (setq cr_list (list cr_pt cr_r))
  167.         (setq p2 (polar jd (+ pi ang2) dist))
  168.         (setq p3 (polar p2 ang2_cz 100))
  169.         (setq cr_pt (inters p1 pt p2 p3 nil))
  170.         (setq cr_r (distance cr_pt pt))
  171.         ;;(command "._circle" cr_pt pt)
  172.         (setvar "cmdecho" oldcmdecho)
  173.         (setvar "osmode" oldosmode)
  174.         (setq cr_list (append cr_list (list cr_pt cr_r)))
  175.        )
  176.        (pt_e2                                ;两线不平行且点在线e2上
  177.         (setq p1 (polar pt ang2_cz 100))
  178.         (setq p2 (polar jd ang1 dist))
  179.         (setq p3 (polar p2 ang1_cz 100))
  180.         (setq cr_pt (inters p1 pt p2 p3 nil))
  181.         (setq cr_r (distance cr_pt pt))
  182.         ;;(command "._circle" cr_pt pt)
  183.         (setq cr_list (list cr_pt cr_r))
  184.         (setq p2 (polar jd (+ pi ang1) dist))
  185.         (setq p3 (polar p2 ang1_cz 100))
  186.         (setq cr_pt (inters p1 pt p2 p3 nil))
  187.         (setq cr_r (distance cr_pt pt))
  188.         ;;(command "._circle" cr_pt pt)
  189.         (setvar "cmdecho" oldcmdecho)
  190.         (setvar "osmode" oldosmode)
  191.         (setq cr_list (append cr_list (list cr_pt cr_r)))
  192.        )
  193.        (t                                ;两线不平行且点不在线上
  194.         (setq ang1 (angle jd p1))
  195.         (setq ang2 (angle jd p2))
  196.         (setq pfx (rem (/ (+ ang1 ang2 (* 4 pi)) 2) (* 2 pi)))
  197.         (if (not (inters p1 p2 jd pt))
  198.           (setq pfx (+ pfx (/ pi 2)))
  199.         )                                ;求得角平分线
  200.         (setq p4 (polar jd pfx 100))        ;求得角平分线上一点
  201.         (setq pfx_cz (+ pfx (/ pi 2)))
  202.         ;;求得过pt点与角平分线的垂足点
  203.         (setq p3 (polar pt pfx_cz 100))
  204.         (setq p3 (inters jd p4 pt p3 nil))
  205.         (setq pfx (angle jd p3))

  207.         (if (< (abs (- dist1 dist2)) 0.00001)
  208.           (progn                        ;如果pt在角平分线上
  209.             (setq p1 (polar pt pfx_cz 100))
  210.             (setq p1 (inters jd e1_star pt p1 nil))
  211.             (setq ang1 (angle p1 jd)
  212.                   ang2 (angle p1 pt)
  213.             )
  214.             (setq ang (rem (/ (+ ang1 ang2 (* 4 pi)) 2) (* 2 pi)))
  215.             (setq p3 (polar p1 ang 100))
  216.             (setq cr_pt (inters jd pt p1 p3 nil))
  217.             (setq cr_r (distance cr_pt pt))
  218.             ;;(command "._circle" cr_pt pt)
  219.             (setq cr_list (list cr_pt cr_r))
  220.             (setq ang (rem (/ (+ ang1 ang2 (* 5 pi)) 2) (* 2 pi)))
  221.             (setq p3 (polar p1 ang 100))
  222.             (setq cr_pt (inters jd pt p1 p3 nil))
  223.             (setq cr_r (distance cr_pt pt))
  224.             ;;(command "._circle" cr_pt pt)
  225.             (setvar "cmdecho" oldcmdecho)
  226.             (setvar "osmode" oldosmode)
  227.             (setq cr_list (append cr_list (list cr_pt cr_r)))
  228.           )
  229.           (progn                        ;如果pt点不在角平分线上
  230.             (setq dist1 (/ (distance p3 jd) 6))
  231.             (setq p4 (polar jd pfx dist1))
  232.             ;;在jd与pt在角平分线上的垂足的1/4处取一点
  233.             (setq p2 (polar p4 ang1_cz 100))
  234.             (setq p1 (inters jd p1 p4 p2 nil))
  235.             (setq dist1 (distance p4 p1))
  236.             (command "._circle" p4 dist1)
  237.             (setq e1 (entlast))
  238.             (command "._pline" jd pt "")
  239.             (setq e2 (entlast))
  240.             (if        (setq jd_list (GetInterPointlist e1 e2)) ;如果圆与pt_jd
  241.               (progn
  242.                 (entdel e1)
  243.                 (entdel e2)
  244.                 (setq p1 (nth 0 jd_list))
  245.                 (setq p2 (nth 1 jd_list))
  246.                 (setq ang (angle p1 p4))
  247.                 (setq p3 (polar pt ang 100))
  248.                 (setq cr_pt (inters jd p4 pt p3 nil))
  249.                 (setq cr_r (distance cr_pt pt))
  250.                 ;;(command "._circle" cr_pt pt)
  251.                 (setq cr_list (list cr_pt cr_r))
  252.                 (setq ang (angle p2 p4))
  253.                 (setq p3 (polar pt ang 100))
  254.                 (setq cr_pt (inters jd p4 pt p3 nil))
  255.                 (setq cr_r (distance cr_pt pt))
  256.                 ;;(command "._circle" cr_pt pt)
  257.                 (setvar "cmdecho" oldcmdecho)
  258.                 (setvar "osmode" oldosmode)
  259.                 (setq cr_list (append cr_list (list cr_pt cr_r)))
  260.               )
  261.               (progn
  262.                 (setvar "cmdecho" oldcmdecho)
  263.                 (setvar "osmode" oldosmode)
  264.                 (setq cr_list nil)
  265.               )
  266.             )
  267.           )
  268.         )
  269.        )
  270.      )
  271.     )                                        ;end 两线不平行
  272.   )

  274. )


setq, pt, cr

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

xyp1964
发表于 2005-6-4 15:00:39 | 显示全部楼层
“直接法”：
[php](command"circle" "3p" pause "tan" pause "tan" pause)[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

ghl_729
发表于 2005-6-8 11:03:04 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
好阿！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

taner

已领礼包: 2个

财富等级: 恭喜发财
发表于 2005-12-26 07:36:48 | 显示全部楼层
最初由 xyp1964 发布
[B]“直接法”：
[php](command"circle" "3p" pause "tan" pause "tan" pause)[/php] [/B]


确实直接!但是,如果点在角平分线上,应该有两个解.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-29 01:14 , Processed in 0.304086 second(s), 39 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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