[编程申请]：过一点与一条线相切的圆或弧（指定半径）

whzhen

请高手们写一段lisp，画过一点与一条线相切的圆或弧（指定半径），画图时经常会碰到，要费好几步功夫，先谢了！

fsxm

将就一下用这个吧：
(setvar "cmdecho" 0)
(defun c:cc (/ r p dss)
  (command "offset"
           (setq r (getdist "\n请输入R=:"))
           (entsel "\n请选要相切的对像(不可选BLOCK):")
           (setq p (getpoint "\n请选点P="))
           ""
  )
  (setq dss (ssadd))
  (setq dss (ssadd (entlast) dss))
  (command "circle" p r)
  (setq dss (ssadd (entlast) dss))
  (princ "\n请选取合适的交点为圆心")
  (command "circle" "int" pause r)
  (command "erase" dss "")
)

whzhen

谢谢！不过请问怎样将“请选取合适的交点为圆心”改为“指定圆心所在侧”的形式自动找到圆心，因为选圆心时容易点错。
另外我想将偏移直线改为构造线，因为还有那种延伸后才相交的情况，

fsxm

楼主你可以选取延伸交点的啊！
好吧改成这样好了：
(setvar "cmdecho" 0)
(defun c:cc (/ r p dss la)
  (command "offset"
           (setq r (getdist "\n请输入R=:"))
           (entsel "\n请选要相切的对像(不可选BLOCK):")
           (setq p (getpoint "\n请选点P="))
           ""
  )
  (setq dss (ssadd))
  (setq dss (ssadd (setq la (entlast)) dss))
  (if (= (cdr (assoc 0 (entget la))) "LINE")
    (command "xline"
             "non"
             (trans (cdr (assoc 10 (entget la))) 0 1)
             "non"
             (trans (cdr (assoc 11 (entget la))) 0 1)
             ""
             "erase"
             (ssadd la)
             ""
    )
  )
  (setq dss (ssadd (entlast) dss))
  (command "circle" p r)
  (setq dss (ssadd (entlast) dss))
  (princ "\n请选取合适的交点为圆心")
  (command "circle" "int" pause r)
  (command "erase" dss "")
  (princ)
)

whzhen

斜线就麻烦了，我的意思是不好找延伸交点，新程序解决了，
还是希望能自动识别交点就更好了

fsxm

再来一个：功能如何啊？？？
看看这个是不是你想要的结果啦？？？
(setvar "cmdecho" 0)
(defun c:cc (/ r p dss la xline 50p 51p p0 p1 pc)
  (setvar "EDGEMODE" 1)
  (command            "offset"
           (setq r (getdist "\n请输入R=:"))
           (entsel
             "\n请选要相切的对像:line;arc;ellipse;等(不可选BLOCK):"
           )
           (setq p (getpoint "\n请选点P="))
           ""
  )
  (setq dss (ssadd))
  (setq dss (ssadd (entlast) dss))
  (setq xline (entlast))
  (command "circle" p r)
  (setq dss (ssadd (entlast) dss))
  (command "trim" xline "" (entlast) "")
  (setq 50p (cdr (assoc 50 (entget (entlast)))))
  (setq 51p (cdr (assoc 51 (entget (entlast)))))
  (setq p0 (list (* r (cos 50p)) (* r (sin 50p)) 0))
  (setq p1 (list (* r (cos 51p)) (* r (sin 51p)) 0))
  (setq p0 (mapcar '+ p p0))
  (setq p1 (mapcar '+ p p1))
  (setq pc (getpoint "\n指定圆心大概位置:"))
  (command "erase" dss "")
  (command "circle"
           "non"
           (if (< (DISTANCE pc p0) (DISTANCE pc p1))
             p0
             p1
           )
           r
  )
  (princ)
)

xyp1964

参照fsxm的程序：

2. [FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20060430
   
3. ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
   
4. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
   
5. ★1·在acad.lsp中增加(load"xyp_lib.vlx")
   
6. ■2·在每个程序内增加(load"xyp_lib.vlx")
   
7. ■3·在command下，输入(load"xyp_lib.vlx")
   
8. ■4·在菜单.mnl中增加(load"xyp_lib.vlx")
   
9. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
   
10. [COLOR=red] ★通用函数下载地址：[/COLOR]
    
11. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
    
12. [url]http://free.ys168.com/?xyp1964[/url]
    
13. |;
    
14. 
    
15. (defun c:test (/ s1 s2 ptn pt)
    
16.   (cmdla0)
    
17.   (if(null r)(setq r 1000.0))
    
18.   (command "offset"
    
19.            (setq r (UDIST 1 "" "\n请输入圆半径" r nil))
    
20.            (entsel "\n请选要相切的直线: ")
    
21.            (setq p (getpoint "\n请选要经过的点: "))
    
22.            ""
    
23.   )
    
24.   (setq s1 (entlast))
    
25.   (setvar"osmode"0)
    
26.   (command "circle" p r)
    
27.   (setq s2 (entlast))
    
28.   (xyp-mklaco "TEST"1)
    
29.   (if (setq ptn (xyp-get-Inters s2 s1 2))
    
30.     (foreach pt        ptn
    
31.       (command "circle" pt r)
    
32.     )
    
33.     (princ"\n半径太小! ")
    
34.   )
    
35.   (command "erase" s1 s2 "")
    
36.   (cmdla1)
    
37. )[/FONT]

[FONT=courier new](load "xyp_lib.vlx")  ;版本 V.20060430<br /> ;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)<br /> 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：<br /> ★1·在acad.lsp中增加(load"xyp_lib.vlx")<br /> ■2·在每个程序内增加(load"xyp_lib.vlx")<br /> ■3·在command下，输入(load"xyp_lib.vlx")<br /> ■4·在菜单.mnl中增加(load"xyp_lib.vlx")<br /> ■5·将xyp_lib.vlx文件直接拽到cad屏幕<br /> [COLOR=red] ★通用函数下载地址：[/COLOR]<br /> [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]<br /> [url]http://free.ys168.com/?xyp1964[/url]<br /> |;<br /> <br /> (defun c:test (/ s1 s2 ptn pt)<br />   (cmdla0)<br />   (if(null r)(setq r 1000.0))<br />   (command "offset"<br />            (setq r (UDIST 1 "" "\n请输入圆半径" r nil))<br />            (entsel "\n请选要相切的直线: ")<br />            (setq p (getpoint "\n请选要经过的点: "))<br />            ""<br />   )<br />   (setq s1 (entlast))<br />   (setvar"osmode"0)<br />   (command "circle" p r)<br />   (setq s2 (entlast))<br />   (xyp-mklaco "TEST"1)<br />   (if (setq ptn (xyp-get-Inters s2 s1 2))<br />     (foreach pt        ptn<br />       (command "circle" pt r)<br />     )<br />     (princ"\n半径太小! ")<br />   )<br />   (command "erase" s1 s2 "")<br />   (cmdla1)<br /> )[/FONT]

whzhen

“五一”出游没有上网，非常感谢fsxm兄，基本是想要的，我把“指定圆心大概位置”一句移到前面去了，但那些辅助作图过程仍有些“痕迹”，有办法彻底“隐藏”掉吗？再次感谢！

fsxm

可以啊！！不过如果用计算的话就要对像ellipse，spline等就不行了~！
还要区分计算line，circle
就这样相切对像才能全面一点啦！

雨箭风刀

玩玩
;| tpc = 过点作与曲线相切定半径圆---ok!--- by 雨箭风刀.2006.5
支持任意曲线
支持曲线延伸相切
.
|;

命令:tpc
运行过程：
命令: tpc
tpc = 过点作与曲线相切定半径圆---ok!--- by 雨箭风刀.2006.5
相切曲线<退出>:
通过点<退出>:
圆半径<退出>:
选择要保留的一个圆/<全保留>:

命令:

whzhen

下载不了啊，给个源码行吗？

and2008

用tan吧