|
|
;;;求交点的程序 , 返回 ss1 与 ss2 的交点表
(defun C:TEST_INT (/ ss1 ss2 intls)
;;测试程序
(princ "ssget 1 ... ")
(setq ss1 (ssget))
(princ "ssget 2 ... ")
(setq ss2 (ssget))
(setq intls
(intersections ss1 ss2)
)
(princ "\n所求交点为: " )
(princ intls)
(princ)
)
;;求两选择集的交点函数，选择集中可以是直线，圆弧，pline（多义线）
;;你可以将 桥梁中的 垂直的线作为 选择集1， 在绘 垂直线时， 每绘一条，就用ssadd 加入到选择集中
;;将水平的线或弧作为选择集2, 返回值为一个 点表，如果选择集1 是有序的，这求的交点也是有序的，不要
;;重新排序
(defun intersections (SS1 SS2 ;ss1: 选择集1, ss2: 选择集2
/ SSL ;length of SS1
SSL2 ;length of ss2
PTS ;returning list
AOBJ1 ;Object 1
AOBJ2 ;Object 2
N1 ;Loop counter
N2 ;Loop counter
IPTS ;intersects
RTIPTS ;返回值
)
(vl-load-com) ;使用VLISP扩展函数
(setq N1 0 ;index for outer loop
SSL (sslength SS1)
)
(setq ;index for outer loop
SSL2 (sslength SS2)
)
; Outer loop, first through second to last
(while (vla-object AOBJ1)
) ;index for inner loop
; Inner loop, go through remaining objects
(setq N2 0)
(while (vla-object AOBJ2)
;将acad 的句柄转换为 VLISP 的句柄
;Find intersections of Objects
IPTS (vla-intersectwith ;求交点
AOBJ1
AOBJ2
0
) ; variant result
IPTS (vlax-variant-value IPTS)
)
;Variant array has values?
(if (> (vlax-safearray-get-u-bound IPTS 1) 0)
(progn ;array holds values, convert it
(setq IPTS ;to a list.
(vlax-safearray->list IPTS)
)
;Loop through list constructing points
(while (> (length IPTS) 0)
(setq PTS (cons (list (car IPTS)
(cadr IPTS)
(caddr IPTS)
)
PTS
)
IPTS (cdddr IPTS)
)
)
)
)
(setq N2 (1+ N2))
) ;inner loop end
(setq N1 (1+ N1))
) ;outer loop end
(setq rtipts pts) ;返回
) |
|
置顶卡
