- UID
- 76911
- 积分
- 428
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2003-9-3
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
inters函数只能求两直线交点,而调用IntersectWith方法效率太低,
以下提供一种用数学方法求解直线和圆弧交点的途径,供大家讨论:
此函数通过测试速度是IntersectWith方法的两倍,比inters慢两倍.
有兴趣的朋友可以一起想办法改进该函数,毕竟编程经常需要求解直线和圆交点.
[pcode=lisp,true]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;参考<计算机图形学几何工具算法详解>Page176
;;求平面直线与圆交点函数
;;返回值:点表(WCS),单交点((x0 y0)) 双交点((x1 y1) (x2 y2))
(DEFUN LineArcInter (ent1 ent2 bit / linelst arclst
a10 c10 l10 l11 r10 a_vec
c_vec l_vec c_dist l_dist t- det
out VectorS VKross
)
;;行列式值
(DEFUN VKross (vec1 vec2)
(- (* (CAR vec1) (CADR vec2)) (* (CADR vec1) (CAR vec2)))
)
;;向量比例缩放
(DEFUN VectorS (vec scale)
(MAPCAR '* vec (LIST scale scale))
)
;;Main**********************************************************
(IF (= (CDR (ASSOC 0 (SETQ linelst (ENTGET ent1)))) "LINE")
(SETQ arclst (ENTGET ent2))
(SETQ arclst linelst
linelst (ENTGET ent2) ; 圆,直线对调
)
)
(SETQ l10 (CDR (ASSOC 10 linelst))) ; 起点
(SETQ l11 (CDR (ASSOC 11 linelst))) ; 终点
(SETQ c10 (CDR (ASSOC 10 arclst))) ; 圆心
(SETQ r10 (CDR (ASSOC 40 arclst))) ; 半径
(IF (= (CDR (ASSOC 0 arclst)) "CIRCLE")
(SETQ bit (BOOLE 7 2 bit)) ; 圆不存在是否延伸
(SETQ a10 (POLAR c10 (CDR (ASSOC 50 arclst)) r10) ; 弧起点
a_vec (MAPCAR '- (POLAR c10 (CDR (ASSOC 51 arclst)) r10) a10)
;弦矢量
)
)
(SETQ r10 (EXPT r10 2))
(SETQ l_dist (EXPT (DISTANCE l10 l11) 2)) ; 线段长度的平方
(SETQ c_dist (EXPT (DISTANCE l10 c10) 2))
(SETQ l_vec (MAPCAR '- l11 l10)) ; 线段矢量
(SETQ c_vec (APPLY '+ (MAPCAR '* l_vec (MAPCAR '- l10 c10))))
(SETQ det (- (EXPT c_vec 2) (* l_dist (- c_dist r10))))
(COND ((EQUAL det 0. 1E-3)
(SETQ out
(LIST
(LIST
(MAPCAR '+
l10
(VectorS l_vec (SETQ t- (/ (- c_vec) l_dist)))
)
t-
)
)
)
)
((MINUSP det) (SETQ out nil))
(T
(SETQ out
(LIST
(LIST
(MAPCAR
'+
l10
(VectorS l_vec
(SETQ t- (/ (- (+ (SQRT det) c_vec)) l_dist))
)
)
t-
)
(LIST (MAPCAR
'+
l10
(VectorS l_vec
(SETQ t- (/ (- (SQRT det) c_vec) l_dist))
)
)
t-
)
)
)
)
)
;; acExtendNone(0) 两个对象均不延伸。
;; acExtendThisEntity(1) 延伸基本对象(本函数指直线)。
;; acExtendOtherEntity(2) 延伸作为参数传递的对象(本函数指圆弧)。
;; acExtendBoth(3) 延伸两个对象。
;;去除直线延长线的交点
(IF (= (BOOLE 8 2 bit) -3)
(SETQ
out (APPLY
'APPEND
(MAPCAR
(FUNCTION (LAMBDA (x)
(IF (AND (>= (CADR x) 0) (<= (CADR x) 1))
(LIST (CAR x))
nil
)
)
)
out
)
)
)
(SETQ out (MAPCAR 'CAR out))
)
;;去除圆弧延长线的交点
(IF (= (BOOLE 8 1 bit) -2)
(APPLY
'APPEND
(MAPCAR (FUNCTION
(LAMBDA (x)
(IF (>= (VKross (MAPCAR '- x a10) a_vec) 0)
(LIST x)
nil
)
)
)
out
)
)
out
)
)
[/pcode]
本函数是参考<计算机图形学几何工具算法详解>写的,光看lsp比较难看懂,附件中提供了该书Page176.
inters,intersectwith,LineCircleInter 效率比较:
测试结果:
;;Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):
;;
;; (INTER1 LINE1 LINE2)...............1953 / 4.08 <fastest>
;; (LINEARCINTER LINE CIRCLE).........3641 / 2.19
;; (INTER0 LINE1 LINE2)...............4719 / 1.69
;; (INTER0 LINE CIRCLE)...............7969 / 1.00 <slowest>
[pcode=lisp,true]
(DEFUN inter0 (line circle / pts)
(SETQ pts (VLAX-SAFEARRAY->LIST
(VLAX-VARIANT-VALUE
(VLA-INTERSECTWITH
(VLAX-ENAME->VLA-OBJECT line)
(VLAX-ENAME->VLA-OBJECT circle)
ACEXTENDBOTH
)
)
)
)
)
(DEFUN inter1 (line1 line2 / INT IP10 IP11 JP10 JP11 LST1 LST2)
(SETQ ip10 (CDR (ASSOC 10 (SETQ lst1 (ENTGET line1)))))
(SETQ ip11 (CDR (ASSOC 11 lst1)))
(SETQ jp10 (CDR (ASSOC 10 (SETQ lst2 (ENTGET line2)))))
(SETQ jp11 (CDR (ASSOC 11 lst2)))
(SETQ int (INTERS ip10 ip11 jp10 jp11 T))
)
[/pcode] |
|