vlisp 取得兩圖元交點的指令 intersectwith

  • Share this:

autolisp 中取得兩直線的交點指令為 inters .

寫法如下

(setq pt_01 ;; 交點變數名稱

( inters ;; 取得兩直線交點的指令

pt_rad ;; 第一條直線起點

(polar pt_rad

(angle pt_pipe_cl_length pt_center_line_inters)

pipe_cl_length

)

;; 第一條直線終點

pt_cone_big_end_ld ;; 第二條直線起點

pt_cone_big_end_rd ;; 第二條直線終點

nil ;; nil 可取得兩條直線延伸的交點,

;; 不為 nil, 則只求兩直線確實有相交的點, 不求延伸的交點

)

pt_02

(inters

pt_01

(polar pt_01 (* pi 0.5) pipe_cl_length)

pt_rad_top

(polar pt_rad_top pi pipe_cl_length)

nil

)

)

以下是 vlisp 取得兩圖元相交點的範例

intersectwith 範例一

(defun al-intersectwith () ( vl-load-com ) (setq util ( vla-get-utility ( vla-get-activedocument ( vlax-get-acad-object ) ) ) ) ( vla-getentity util 'obj1 'ip "\n選取第一個圖元 : ") ( vla-getentity util 'obj2 'ip "\n選取第二個圖元 : ") (setq int ( vla-IntersectWith obj1 obj2 acExtendBoth )) (princ int ) (princ) ) ;defun

intersectwith 範例二

(defun get_circle_line_inters () ( vl-load-com ) (SETQ En_A ( car (ENTSEL "\n 選取物件 A"))) (SETQ En_B ( car (ENTSEL "\n 選取物件 B"))) (SETQ OBJ_A ( VLAX-ENAME->VLA-OBJECT En_A)) (SETQ OBJ_B ( VLAX-ENAME->VLA-OBJECT En_B))

(setq INTLST ( vl-catch-all-apply ' vlax-safearray->list ( list ( vlax-variant-value ( vla-intersectwith OBJ_A OBJ_B acextendnone ) ) ) ) )

(IF (not ( vl-catch-all-error-p INTLST)) (SETQ INT INTLST) (SETQ INT ( vlax-safearray->list ( VLAX-VARIANT-VALUE ( VLA-INTERSECTWITH OBJ_A OBJ_B acExtendBoth ) ) ) ) ) )

intersectwith 範例三 ;   阿貴 google 到的 取得圖元交點的 vlisp 程式

; -- Function MeGetInters

; Returns all intersection points between two objects. ; Copyright: ;     ?2000 MENZI ENGINEERING GmbH, Switzerland ; Arguments [Type]: ;    Fst = First object [VLA-OBJECT] ;    Nxt = Second object [VLA-OBJECT] ;    Mde = Intersection mode [INT] ;              Constants: ;              - acExtendNone Does not extend either object. ;              - acExtendThisEntity Extends the Fst object. ;              - acExtendOtherEntity Extends the Nxt object. ;              - acExtendBoth Extends both objects. ; Return [Type]: ;     > List of points '((1.0 1.0 0.0)... [LIST] ;     > Nil if no intersection found ; Notes: ;     - None ; (defun MeGetInters (Fst Nxt Mde / IntLst PntLst) (setq IntLst (vlax-invoke Fst ' IntersectWith Nxt Mde)) (cond (IntLst (repeat (/ (length IntLst) 3) (setq PntLst (cons (list (car IntLst) (cadr IntLst) (caddr IntLst) ) PntLst ) IntLst (cdddr IntLst) ) ) (reverse PntLst) ) (T nil) ) )

以下是以範例三的寫法, 套用到阿貴寫的 [ 圓管插到大小頭 ] 展開程式中,

要取得圓管分割線(圖元為 line), 和大小頭底部大圓孔(圖元為 circle) 兩者的交點.

(defun get_inters_of_cl (Fst Nxt Mde / IntLst PntLst)

(setq IntLst ( vlax-invoke Fst ' IntersectWith Nxt Mde)) ( cond (IntLst ( repeat (/ ( length IntLst) 3) (setq PntLst ( cons ( list ( car IntLst) ( cadr IntLst) ( caddr IntLst) ) PntLst ) IntLst ( cdddr IntLst) ) ) ( reverse PntLst) ) (T nil)

) (if (> ( length PntLst) 1) (setq PntLst ( vl-sort PntLst '( lambda (lista listb) (> ( car lista) ( car listb))) ) ) )  ;; 如果有兩個交點, 阿貴要 x 座標值較大的交點 (setq pt_05 (nth 0 PntLst))  ;; pt_05 即是圓和直線的交點中, x 座標值較大的那個

)


Tags: