- UID
- 726726
- 积分
- 141
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2014-2-19
- 最后登录
- 1970-1-1
|
马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。
您需要 登录 才可以下载或查看，没有账号？立即注册
×
已知一个圆弧和一条直线,指定点于圆弧上一点,在不改变该点在圆弧上的切角求出相切于直线,算出圆弧中心点，半径，起始角，终止角,在线上的切点
 - (defun fx_tang_arc_line (linept1 linept2 arcpt3 or-arc-cen / arc_centerpoint refrence-point arc_r tang_point lengtha lengthb
- lengthc cosa_lgx ref-length-1 ref-length-2 ref-length-3 arc_star-ang arc_end-ang)
- ;;;原创,编写:刘国新
- ;;;或者说 1, 已知通过一点及这点的角度(即给定原圆心点)相切于一直线求出圆弧中心点，半径，起始角，终止角,在线上的切点
- ;;;或者说 2, 已知一个圆弧和一条直线,指定点于圆弧上一点,在不改变该点在圆弧上的切角求出相切于直线
- ;;; 算出圆弧中心点，半径，起始角，终止角,在线上的切点
- (if (or (equal (angle linept1 linept2)(angle linept1 arcpt3) 0.00005)(equal (angle linept1 linept2)(angle linept2 arcpt3) 0.00005))
- (setq arc_centerpoint nil)
- (progn
- (if (or (equal (angle linept1 linept2)(angle or-arc-cen arcpt3) 0.00005)
- (equal (angle linept1 linept2)(angle arcpt3 or-arc-cen) 0.00005))
- (if (= or-arc-cen nil)
- (setq arc_centerpoint nil)
- (progn
- (setq refrence-point (inters or-arc-cen (polar or-arc-cen (+ (angle or-arc-cen arcpt3) (* pi 0.5)) 5.0) linept1 linept2 nil))
- (setq arc_r (distance refrence-point or-arc-cen))
- (setq arc_centerpoint (polar arcpt3 (angle arcpt3 or-arc-cen) arc_r))
- (setq tang_point (inters arc_centerpoint (polar arc_centerpoint (+ (angle arc_centerpoint arcpt3) (* pi 0.5)) 5.0)
- linept1 linept2 nil))
- )
- )
- (if (= or-arc-cen nil)
- (setq arc_centerpoint nil)
- (progn
- (setq refrence-point (inters linept1 linept2 arcpt3 or-arc-cen nil))
- (setq lengtha (distance linept1 refrence-point))
- (setq lengthb (distance refrence-point or-arc-cen))
- (setq lengthc (distance or-arc-cen linept1))
- (if (< (max lengthc lengtha lengthb)(- (+ lengthc lengtha lengthb) (max lengthc lengtha lengthb)))
- (if (or (= lengthc 0) (= lengtha 0) (= lengthb 0))
- (princ "\n请输入正确的数值!\n")
- (progn
- (setq cosa_lgx (/ (- (+ (* lengtha lengtha)(* lengthb lengthb))(* lengthc lengthc))
- (* lengtha lengthb 2)))
- (setq cosa_lgx (- (/ pi 2.0) (atan (/ cosa_lgx (sqrt (- 1.0 (* cosa_lgx cosa_lgx)))))))
- )
- )
- (princ "\n请输入正确的数值!\n")
- )
- (setq ref-length-1 (distance arcpt3 refrence-point))
- (setq ref-length-2 (abs (/ ref-length-1 (cos cosa_lgx))))
- (setq ref-length-3 (abs (* ref-length-1 (/ (sin cosa_lgx)(cos cosa_lgx)))))
- (if (equal (angle refrence-point or-arc-cen)(angle arcpt3 or-arc-cen) 0.000005)
- (setq tang_point (polar refrence-point (angle refrence-point (inters arcpt3 (polar arcpt3 (+ (angle arcpt3 or-arc-cen)
- (* pi 0.5)) 5.0) linept1 linept2 nil)) (+ ref-length-2 ref-length-3)))
- (setq tang_point (polar refrence-point (angle refrence-point (inters arcpt3 (polar arcpt3 (+ (angle arcpt3 or-arc-cen)
- (* pi 0.5)) 5.0) linept1 linept2 nil)) (- ref-length-2 ref-length-3)))
- )
- (setq arc_centerpoint (inters tang_point (polar tang_point (+ (angle linept1 linept2) (* pi 0.5)) 5.0)
- refrence-point or-arc-cen nil))
- (setq arc_r (distance arc_centerpoint tang_point))
- )
- )
- )
- )
- )
- (if (/= arc_centerpoint nil)
- (progn
- (if (and (>= (angle linept1 tang_point) (* pi 0.5))(< (angle linept1 tang_point) (* pi 1.5)))
- (if (equal (- (angle linept1 tang_point)(* pi 0.5))(angle arc_centerpoint tang_point) 0.00005)
- (progn
- (setq arc_star-ang (angle arc_centerpoint tang_point))
- (setq arc_end-ang (angle arc_centerpoint arcpt3))
- )
- (progn
- (setq arc_star-ang (angle arc_centerpoint arcpt3))
- (setq arc_end-ang (angle arc_centerpoint tang_point))
- )
- )
- (if (and (< (angle linept1 tang_point) (* pi 2.0)) (>= (angle linept1 tang_point) (* pi 1.5)))
- (if (equal (- (angle linept1 tang_point)(* pi 0.5))(angle arc_centerpoint tang_point) 0.00005)
- (progn
- (setq arc_star-ang (angle arc_centerpoint tang_point))
- (setq arc_end-ang (angle arc_centerpoint arcpt3))
- )
- (progn
- (setq arc_star-ang (angle arc_centerpoint arcpt3))
- (setq arc_end-ang (angle arc_centerpoint tang_point))
- )
- )
- (if (equal (+ (angle linept1 tang_point)(* pi 0.5))(angle arc_centerpoint tang_point) 0.00005)
- (progn
- (setq arc_star-ang (angle arc_centerpoint arcpt3))
- (setq arc_end-ang (angle arc_centerpoint tang_point))
- )
- (progn
- (setq arc_star-ang (angle arc_centerpoint tang_point))
- (setq arc_end-ang (angle arc_centerpoint arcpt3))
- )
- )
- )
- )
- (if (equal arc_r 0.00005)
- nil
- (list arc_centerpoint arc_r arc_star-ang arc_end-ang tang_point)
- )
- )
- nil
- )
- )
- (defun c:fparc_lgx (/ *error* cm_lgx title_lgx ucs_lgx os_lgx or-arc-cen arcpt3 ss_lgx start_point end_point linept1
- linept2 loop first-time f_point_lgx temp result_lgx arc_centerpoint arc_r arc_star-ang arc_end-ang
- end-point)
- ;;;原创,编写:刘国新
- ;;;选择一个圆弧和一条直线,指定点于圆弧上一点,在不改变该点在圆弧上的切角画相切于直线的圆弧
- (defun *error* (msg)
- (command "undo" "E")
- (command "undo" "")
- (redraw)
- (princ "非正常退出,或参数有误!!!")
- (princ)
- )
- (setq cm_lgx (getvar "cmdecho"))
- (setvar "cmdecho" 0)
- (command "undo" "BE")
- (setq title_lgx (getvar "modemacro"))
- (setvar "modemacro" "刘国新工具集==>固定指定点的切角圆弧相切于直线")
- (setq ucs_lgx (getvar "ucsorg"))
- (command "ucs" "w")
- (setq os_lgx (getvar "osmode"))
- (setq or-arc-cen (cdr (assoc 10 (entget (setq del_part (car (entsel "\n选择要改变相切的圆弧:")))))))
- (if or-arc-cen
- (setq arcpt3 (getpoint "\n选取点(不改变圆弧在此点的切角):"))
- )
- (if arcpt3
- (setq ss_lgx (entsel "\n选择一条要相切的直线:"))
- )
- (if ss_lgx
- (if (= (cdr (assoc 0 (entget (car ss_lgx)))) "LINE")
- (progn
- (setq start_point (cdr (assoc 10 (entget (car ss_lgx)))))
- (setq end_point (cdr (assoc 11 (entget (car ss_lgx)))))
- (if (< (distance (cadr ss_lgx) start_point)(distance (cadr ss_lgx) end_point))
- (progn
- (setq linept1 end_point)
- (setq linept2 start_point)
- )
- (progn
- (setq linept1 start_point)
- (setq linept2 end_point)
- )
- )
- (command "erase" del_part "")
- (command "erase" (car ss_lgx) "")
- (setq loop t)
- (setq first-time nil)
- (setvar "osmode" 0)
- (princ "\n反转相切[R]")
- (while loop
- (if (= lastpoint_lgx nil)
- (setq lastpoint_lgx (list 0 0))
- )
- (setq f_point_lgx (get-gr_point_lgx lastpoint_lgx "f3,f8" 1));;;程序太大,不提供
- (if (or (= (caddr (cadr f_point_lgx)) 82)(= (caddr (cadr f_point_lgx)) 114));;;r
- (progn
- (redraw)
- (setq temp arc_end-ang)
- (setq arc_end-ang arc_star-ang)
- (setq arc_star-ang temp)
- )
- (progn
- (if (= first-time nil)
- (progn
- (if (= (setq result_lgx (fx_tang_arc_line linept1 linept2 arcpt3 or-arc-cen)) nil)
- (progn
- (setq loop nil)
- (princ "\n不能构成一个圆弧!!!\n")
- (exit)
- )
- (progn
- (setq arc_centerpoint (car result_lgx))
- (setq arc_r (cadr result_lgx))
- (setq arc_star-ang (caddr result_lgx))
- (setq arc_end-ang (nth 3 result_lgx))
- (setq end-point (nth 4 result_lgx))
- )
- )
- (setq first-time 1)
- )
- )
- )
- )
- (if (/= (cadr (cadr f_point_lgx)) nil)
- (setq loop nil)
- )
- (if result_lgx
- (progn
- (rough-show_circle_lgx nil nil nil arc_centerpoint arc_r arc_star-ang arc_end-ang nil 0.5 6);;;程序太大,不提供
- (grvecs (list 6 linept1 end-point))
- )
- )
- )
- (redraw)
- (if result_lgx
- (progn
- (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
- 'Addarc arc_centerpoint arc_r arc_star-ang arc_end-ang)
- (command "line" linept1 end-point "")
- )
- )
- )
- (princ "\n选择错误,程序即出!\n")
- )
- (princ "\n没有选择,程序即出!\n")
- )
- (setvar "osmode" os_lgx)
- (command "ucs" "n" ucs_lgx)
- (setvar "modemacro" title_lgx)
- (princ "\n祝你工作愉快!!!\n")
- (command "undo" "E")
- (setvar "cmdecho" cm_lgx)
- (princ)
- )
|
|
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园
( 辽ICP备15016793号 )
窥视卡
雷达卡
已领礼包: 
财富等级: 
发表于 2014-9-6 12:30:07
提升卡
置顶卡
沉默卡
变色卡
千斤顶
发表于 2014-9-6 12:59:06
