[求助]两线段的关系。
1. 如何取得两条线段夹角(不大于90度)2. 判断两线段是否平行
3. 判断两线段是否可以连接成为一条线段
两线段应该还有其它关系，希望高手丰富一下。
用向量来判断，点乘叉乘 在误差范围内，以下两线段认定为同一图元列表。
详见DWG文件。
最终想实现的是，将两条线段扩展到N条线段，误差参数: x y 角度。
当然，大家时间宝贵。只要各位有兴趣，能把两条线段的关系解决。就很不错了。
谢谢。:)
;; http://www.cnweblog.com/funhome/archive/2008/03/12/278098.html
;;判断空间两直线平行，不考虑重合．by 狂刀.2005.12
;;参数: li1,li2 为直线实体名.
;;返回: 平行返回T,不平行返回nil.
(defun is= (li1 li2 / a b c b1 d1 d2)
(setq a (vlax-curve-getfirstderiv li1 (vlax-curve-getstartparam li1))
b (vlax-curve-getfirstderiv li2 (vlax-curve-getstartparam li2))
d1 (vlax-curve-getDistAtParam li1 (vlax-curve-getEndParam li1))
d2 (vlax-curve-getDistAtParam li2 (vlax-curve-getEndParam li2))
;将第二条直线改化成与第一条等长的向量;
c (/ d1 d2)
b (mapcar '* b (list c c c))
;反向向量;
b1 (mapcar '* b (list -1 -1 -1))
)
(or (equal a b 1e-4);同向向量;
(equal a b1 1e-4) ;反向向量;
)
)
;; 测试,命令c:is=
(defun c:is= ()
(princ "\n判断空间两直线平行!")
(setq li1 (car (entsel "\n选直线1:"))
li2 (car (entsel "\n选直线2:"))
)
(is= (vlax-ename->vla-object li1) (vlax-ename->vla-object li2))
)
(defun tk (en p / a b c)
(princ (setq a (vlax-curve-getParamAtPoint en p)))
(princ " ")
(princ (angle p (vlax-curve-getPointAtDist en (+ 0.001 (vlax-curve-getDistAtPoint en p)))))
(princ " ")
(princ (angle '(202.5903 366.1556 0) p))
(princ " ")
(princ (vlax-curve-getfirstderiv en a))
(princ " ")
)
(defun c:k ( / a b c)
(setq li1 (car (entsel "\n选直线1:"))
)
(tk (vlax-ename->vla-object li1) (getpoint "\nget point:"))
)
回复 carrot1983 的帖子
;;;=======================[ GlueAllLines.lsp ]=======================
;;; Author: Copyright? 2006 Charles Alan Butler
;;; Version:1.1 Feb 09, 2006
;;; Purpose: To glue all lines that are end to end & on the same layer
;;; and not on a locked layer
;;; Selection is by user or current space or all drawing
;;; Sub_Routines: ss->lst creates a data list of all the lines
;;; gluewill glue two lines
;;; Requirements: None
;;;
;;;==============================================================
(defun C:GLUEALLLINES (/ MASTERLIST ITM LAY
TMP NEWLST LAYIDX TARIDX LAYGROUP
FUZZ ELST IDX NEWLN NEWTARGET
SS TARGET
)
;;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-
;;; -
;;; Functions -
;;; -
;;; -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=- -=<*>=-
;;====================================================================
;;returns a list of enity info ((ename layer stpt endpt space) ...)
(defun SS->LST (SS2 / I ENAME RESULT ELST)
(setq I -1)
(while (setq ENAME (ssname SS2 (setq I (1+ I))))
(setq ELST (entget ENAME)
RESULT (cons
(list ENAME ; ent name
(cdr (assoc 8 ELST)) ; layer
(cdr (assoc 10 ELST)) ; start pt
(cdr (assoc 11 ELST)) ; end pt
(cdr (assoc 410 ELST)) ; space
)
RESULT
)
)
)
)
;;Alan Butler 02/05/06
;;returns nil if lines are not joined
(defun GLUE (FLIN SLIN / P1 P2 P3 P4 FLIST
SLISTF1PT F2PT S1PT S2PT OVERLAP PARALLEL
FUZZ
)
;; determine if p1 & p4 are in the same direction
(defun OVERLAP (P1 P2 P3 P4)
(equal (angle P2 P1) (angle P3 P4) 1.001)
)
;;test for parallel CAB 10/18/05
(defun PARALLEL (LN1 LN2 / ANG1 ANG2 PFUZZ)
(if (= (type LN1) 'ENAME)
(setq LN1 (entget LN1)
LN2 (entget LN2)
)
)
(setq ANG1 (angle (cdr (assoc 10 LN1)) (cdr (assoc 11 LN1))))
(setq ANG2 (angle (cdr (assoc 10 LN2)) (cdr (assoc 11 LN2))))
(setq PFUZZ 0.001)
(or (equal ANG1 ANG2 PFUZZ)
;;Check for lines drawn in opposite directions
(equal (min ANG1 ANG2) (- (max ANG1 ANG2) pi) PFUZZ)
)
)
;;***Start of Routine***
(if (and FLIN SLIN)
(progn
(setq FUZZ 0.01) ; alowable line endpoint gap
(setq FLIST (entget FLIN))
(setq SLIST (entget SLIN))
(if (PARALLEL FLIST SLIST)
(progn
(setq F1PT (cdr (assoc 10 FLIST)))
(setq F2PT (cdr (assoc 11 FLIST)))
(setq S1PT (cdr (assoc 10 SLIST)))
(setq S2PT (cdr (assoc 11 SLIST)))
;;find end point match
(cond ((< (distance F1PT S1PT) FUZZ)
(setq P1 F2PT ; start of new line
P2 F1PT ; intersect of old lines
P3 S1PT ; intersect of old lines
P4 S2PT ; end of new line
)
)
((< (distance F2PT S1PT) FUZZ)
(setq P1 F1PT
P2 F2PT
P3 S1PT
P4 S2PT
)
)
((< (distance F1PT S2PT) FUZZ)
(setq P1 F2PT
P2 F1PT
P3 S2PT
P4 S1PT
)
)
((< (distance F2PT S2PT) FUZZ)
(setq P1 F1PT
P2 F2PT
P3 S2PT
P4 S1PT
)
)
)
(if (and P1 (not (OVERLAP P1 P2 P3 P4)))
(progn
(cond
((equal P1 (cdr (assoc 11 FLIST)))
(setq
FLIST (subst (cons 10 P4) (assoc 10 FLIST) FLIST)
)
)
((equal P4 (cdr (assoc 10 FLIST)))
(setq
FLIST (subst (cons 11 P1) (assoc 11 FLIST) FLIST)
)
)
((setq FLIST (subst (cons 10 P1) (assoc 10 FLIST) FLIST)
FLIST (subst (cons 11 P4) (assoc 11 FLIST) FLIST)
)
)
)
(entmod FLIST) ; keeps the same properties of the first line
(entdel SLIN) ; second line is discarded
)
)
)
)
)
)
)
;; o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o
;; S T A R T O F R O U T I N E
;; o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o-o
(prompt
"\nSelect lines to join or Enter for all lines in drawing."
)
(if
(or (setq SS (ssget '((0 . "LINE")))) ; user selected lines
(and (not (initget "Yes No"))
(/= (getkword
"\n***Limit to lines in current space? <Yes>***"
)
"No"
)
(setq
SS (ssget "_X"
(list '(0 . "LINE") (cons 410 (getvar "ctab")))
)
)
)
(setq SS (ssget "_X" '((0 . "LINE"))))
) ; get all lines
(progn
(command ".undo" "begin")
(setq MASTERLIST (SS->LST SS)) ; create a list of entity data
;;sort the list on layer
(setq MASTERLIST
(vl-sort MASTERLIST
'(lambda (E1 E2) (< (cadr E1) (cadr E2)))
)
)
(setq LAY (cadar MASTERLIST)) ; first layer
;;create sub list grouped by layer
(foreach ITM MASTERLIST
(if (= LAY (cadr ITM))
(setq TMP (cons ITM TMP))
(setq NEWLST (cons TMP NEWLST)
TMP (list ITM)
LAY (cadr ITM)
)
)
)
(if TMP
(setq NEWLST (cons TMP NEWLST))
)
;;foreach layer group
;;Note that a WHILE is used as FOREACH will not handle changing list
(setq LAYIDX -1)
(while (< (setq LAYIDX (1+ LAYIDX)) (length NEWLST))
;;foreach item check with the other items for a match
(setq TARIDX -1)
(setq LAYGROUP (nth LAYIDX NEWLST))
(while (< (setq TARIDX (1+ TARIDX)) (length LAYGROUP))
(if (setq TARGET (nth TARIDX LAYGROUP))
(progn
;;foreach other item combine lines within layer groups
(setq IDX -1)
(while (< (setq IDX (1+ IDX)) (length LAYGROUP))
(if (and (setq ITM (nth IDX LAYGROUP))
; check for nil -> removed line
(not (equal (car TARGET) (car ITM)))
(= (nth 4 TARGET) (nth 4 ITM))
;in same space? model or layouts
)
;;try to glue the lines
(if (GLUE (car TARGET) (car ITM))
;;they are joined, so update list
;;update the sublist, new end points & nil deleted line
(setq ELST (entget (car TARGET))
NEWTARGET (list (car TARGET) ; ent name
(cdr (assoc 8 ELST)) ; layer
(cdr (assoc 10 ELST))
; start pt
(cdr (assoc 11 ELST))
; end pt
(cdr (assoc 410 ELST))
; space
)
LAYGROUP(subst NEWTARGET TARGET LAYGROUP)
LAYGROUP(subst NIL ITM LAYGROUP)
; remove deleted line, nil will be a place holder
TARGET NEWTARGET
IDX -1 ; start the loop again because the targat end points changed
)
)
)
)
)
)
)
) ; while
(command ".undo" "end")
)
)
(princ)
)
(prompt
"\nGlue All Lines Loaded, Enter GlueAllLines to run."
)
(princ)
还有，当线段和线段重叠时的情况。 本帖最后由 lht 于 2011-6-9 17:40 编辑
;;;;求两线段的夹角，B为两线段的连接点。
(setq cosB (/ (- (+ (* a a) (* c c)) (* b b)) (* 2 a c))) ;a、b、c分别为角对应的三角形边长
(if (< cosB 0) (setq ang (+ 180 (/ (* (atan (/ (sqrt (- 1 (* cosB cosB))) cosB)) 180) pi))));为钝角
(if (> cosB 0) (setq ang (/ (* (atan (/ (sqrt (- 1 (* cosB cosB))) cosB)) 180) pi))) ;为锐角
(if (= cosB 0) (setq ang 90)) ;为直角
求出余弦值cosB后，用下边的三个判断式来判断是钝角、锐角还是直角，并求出夹角ang(角度)。
;;;;;判断两线段是否平行，p1、p2为一线段的起点和终点，p3、p4为另一线段的起点和终点
(setq ang1 (/ (* (angle p1 p2) 180) pi))
(setq ang2 (/ (* (angle p3 p4) 180) pi))
如果ang1和ang2相等，则两线段是平行的。
如果ang1和ang2相等，则两线段是平行的。
ang1和ang2相差180度呢？ 本帖最后由 lht 于 2011-6-9 20:59 编辑
ang1和ang2相差180度呢？
楼主的问题是判断两直线是否平行，如果不考虑方向，相差180度也是平行的关系。
准确的表述应为：（or (=(- ang1 ang2) 0) (=(abs (- ang1 ang2)) 180)) 两线段平行。
不是你想象这么简单滴
页:
[1]
2