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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 过一点相切于直线端点
返回列表 发新帖
查看: 1965|回复: 6

[每日一码] 过一点相切于直线端点

[复制链接]
lgx9612

已领礼包: 146个

财富等级: 日进斗金
发表于 2014-9-5 12:33:41 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
已知通过一点相切于一直线的一端点求出圆弧中心点，半径，起始角
  2. (defun tangarctoline (linept1 linept2 arcpt3 / lengtha lengthb lengthc cosa_lgx cal_angle arc_r refrence-point arc_centerpoint
  3.          arc_star-ang arc_end-ang)
  4. ;;;原创,编写:刘国新
  5. ;;;已知通过一点相切于一直线的一端点求出圆弧中心点，半径，起始角，终止角
  6. (if (or (= (angle linept1 linept2)(angle linept1 arcpt3))(= (angle linept1 linept2)(angle linept2 arcpt3)))
  7. nil  
  8. (progn
  9. (setq lengtha (distance linept2 arcpt3))
  10. (setq lengthb (distance linept1 linept2))
  11. (setq lengthc (distance linept1 arcpt3))
  12. (if (< (max lengthc lengtha lengthb)(- (+ lengthc lengtha lengthb) (max lengthc lengtha lengthb)))
  13. (if (or (= lengthc 0) (= lengtha 0) (= lengthb 0))
  14. (princ "\n请输入正确的数值!\n")
  15. (progn
  16. (setq cosa_lgx (/ (- (+ (* lengtha lengtha)(* lengthb lengthb))(* lengthc lengthc))
  17.                 (* lengtha lengthb 2)))
  18. (setq cosa_lgx (- (/ pi 2.0) (atan (/ cosa_lgx (sqrt (- 1.0 (* cosa_lgx cosa_lgx)))))))
  19. )
  20. )
  21. (princ "\n请输入正确的数值!\n")
  22. )
  23. (if (> cosa_lgx (* pi 0.5))
  24. (setq cal_angle (- cosa_lgx (* pi 0.5)))
  25. (setq cal_angle (- (* pi 0.5) cosa_lgx))
  26. )
  27. (setq arc_r (/ (/ lengtha 2.0)(cos cal_angle)))
  28. (setq refrence-point (inters arcpt3 (polar arcpt3 (+ (angle linept1 linept2) (* pi 0.5)) 5.0) linept1 linept2 nil))
  29. (if (and (>= (angle linept1 linept2) (* pi 0.5))(< (angle linept1 linept2) (* pi 1.5)))  
  30. (progn
  31. (if (> (angle linept1 linept2)(angle refrence-point arcpt3))
  32. (progn
  33. (setq arc_centerpoint (polar linept2 (- (angle linept1 linept2) (* pi 0.5)) arc_r))
  34. (setq arc_star-ang (angle arc_centerpoint arcpt3))
  35. (setq arc_end-ang (angle arc_centerpoint linept2))
  36. )
  37. (progn
  38. (setq arc_centerpoint (polar linept2 (+ (angle linept1 linept2) (* pi 0.5)) arc_r))
  39. (setq arc_star-ang (angle arc_centerpoint linept2))
  40. (setq arc_end-ang (angle arc_centerpoint arcpt3))
  41. )
  42. )
  43. )
  44. (if (> (angle linept2 linept1)(angle refrence-point arcpt3))
  45. (progn
  46. (setq arc_centerpoint (polar linept2 (+ (angle linept1 linept2) (* pi 0.5)) arc_r))
  47. (setq arc_star-ang (angle arc_centerpoint linept2))
  48. (setq arc_end-ang (angle arc_centerpoint arcpt3))
  49. )
  50. (progn
  51. (setq arc_centerpoint (polar linept2 (- (angle linept1 linept2) (* pi 0.5)) arc_r))
  52. (setq arc_star-ang (angle arc_centerpoint arcpt3))
  53. (setq arc_end-ang (angle arc_centerpoint linept2))
  54. )
  55. )
  56. )
  57. (list arc_centerpoint arc_r arc_star-ang arc_end-ang)
  58. )
  59. )
  60. )

  62. (defun c:tarc_lgx (/ cm_lgx ucs_lgx os_lgx arcpt3 ss_lgx start_point end_point linept1 linept2 arc-item loop operate temp result_lgx
  63.       arc_centerpoint arc_r arc_star-ang arc_end-ang myms_lgx )
  64. ;;;原创,编写:刘国新
  65. ;;;已知通过一点相切于一直线的一端点画圆弧
  66. (setq cm_lgx (getvar "cmdecho"))
  67. (setvar "cmdecho" 0)
  68. (command "undo" "BE")
  69. (setq ucs_lgx (getvar "ucsorg"))
  70. (command "ucs" "w")
  71. (setq os_lgx (getvar "osmode"))
  72. (setq arcpt3 (getpoint "\n选取点:"))
  73. (setq ss_lgx (entsel "\n选择一条要相切的直线:"))
  74. (setq start_point (cdr (assoc 10 (entget (car ss_lgx)))))
  75. (setq end_point (cdr (assoc 11 (entget (car ss_lgx)))))
  76. (if (< (distance (cadr ss_lgx) start_point)(distance (cadr ss_lgx) end_point))
  77. (progn
  78. (setq linept1 end_point)
  79. (setq linept2 start_point)
  80. )
  81. (progn
  82. (setq linept1 start_point)
  83. (setq linept2 end_point)
  84. )
  85. )
  86. (setq arc-item nil)
  87. (setq loop t)
  88. (while loop
  89. (if arc-item
  90. (command "erase" (vlax-vla-object->ename arc-item)  "")
  91. )
  92. (if (or (= operate "R")(= operate "r"))
  93. (progn
  94. (setq temp arc_end-ang)
  95. (setq arc_end-ang arc_star-ang)
  96. (setq arc_star-ang temp)
  97. )
  98. (progn
  99. (if (or (= operate "D")(= operate "d"))
  100. (progn
  101. (setq temp linept2)
  102. (setq linept2 linept1)
  103. (setq linept1 temp)
  104. )
  105. )
  106. (setq result_lgx (tangarctoline linept1 linept2 arcpt3))
  107. (setq arc_centerpoint (car result_lgx))
  108. (setq arc_r (cadr result_lgx))
  109. (setq arc_star-ang (caddr result_lgx))
  110. (setq arc_end-ang (nth 3 result_lgx))
  111. )
  112. )
  113. (setvar "osmode" 0)
  114. (setq myms_lgx (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
  115. (setq arc-item (vlax-invoke  myms_lgx 'Addarc arc_centerpoint arc_r arc_star-ang arc_end-ang))
  116. (setq operate (getstring "反转相切[R] ,反转端点[D]"))
  117. (if (or (= operate "R")(= operate "r")(= operate "D")(= operate "d"))
  118. (setq loop t)  
  119. (setq loop nil)
  120. )
  121. )
  122. (setvar "osmode" os_lgx)
  123. (command "ucs" "n" ucs_lgx)
  124. (command "undo" "E")
  125. (setvar "cmdecho" cm_lgx)
  126. (princ)
  127. )

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

使用道具 举报

csharp

已领礼包: 859个

财富等级: 财运亨通
发表于 2014-9-5 12:42:45 来自手机 | 显示全部楼层
可以简化   

点评

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

使用道具 举报

lgx9612

已领礼包: 146个

财富等级: 日进斗金
 楼主| 发表于 2014-9-5 18:45:54 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
csharp 发表于 2014-9-5 12:42
可以简化

请不吝赐教

点评

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

使用道具 举报

csharp

已领礼包: 859个

财富等级: 财运亨通
发表于 2014-9-5 19:23:30 | 显示全部楼层
本帖最后由 csharp 于 2014-9-5 19:26 编辑
lgx9612 发表于 2014-9-5 18:45
请不吝赐教

没有写完，供参考，弦中垂线与过线端点的垂线两者交点即圆心，剩下就是判断起始角谁大小了
  1. (defun lnarc (p ln / midp sp ep an _pi2 p1 p2 pc1 pc2)
  2.   (defun midp (p1 p2)
  3.     (mapcar '(lambda (x1 x2)
  4.                (/ (+ x1 x2) 2)
  5.              )
  6.             p1
  7.             p2
  8.     )
  9.   )
  10.   (setq        sp   (vlax-curve-getstartpoint ln)
  11.         ep   (vlax-curve-getendpoint ln)
  12.         an   (angle sp ep)
  13.         _pi2 (/ pi 2)
  14.         p1   (midp p sp)
  15.         p2   (midp p ep)
  16.         pc1  (inters sp
  17.                      (polar sp (+ an _pi2) 1.)
  18.                      p1
  19.                      (polar p1 (+ (angle p sp) _pi2) 1.)
  20.                      nil
  21.              )
  22.         pc2  (inters ep
  23.                      (polar ep (+ an _pi2) 1.)
  24.                      p1
  25.                      (polar p2 (+ (angle p ep) _pi2) 1.)
  26.                      nil
  27.              )
  28.   )
  29. )

点评

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

使用道具 举报

lgx9612

已领礼包: 146个

财富等级: 日进斗金
 楼主| 发表于 2014-9-5 20:12:11 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
csharp 发表于 2014-9-5 19:23
没有写完，供参考，弦中垂线与过线端点的垂线两者交点即圆心，剩下就是判断起始角谁大小了

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

使用道具 举报

xvjiex

已领礼包: 1094个

财富等级: 财源广进
发表于 2021-7-5 00:04:08 | 显示全部楼层
感谢楼主分享过一点相切于直线端点！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

hh_lj007

已领礼包: 756个

财富等级: 财运亨通
发表于 2021-7-5 08:16:39 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
感谢楼主和大师分享源码！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-15 13:33 , Processed in 0.381799 second(s), 44 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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