[编程交流] 曲线之间的交点

(setq intpt2 (vlax-invoke obj3 'intersectWith obj1 acExtendThisEntity))

[b][color=BLACK]([/color][/b]defun c:test [b][color=FUCHSIA]([/color][/b] / ent1 ent2 obj1 obj2 int-lst cnt pt pt-lst [b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]vl-load-com[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setvar 'errno 0[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]while
        [b][color=NAVY]([/color][/b]not
                [b][color=MAROON]([/color][/b]and
                        [b][color=GREEN]([/color][/b]setq ent1 [b][color=BLUE]([/color][/b]car [b][color=RED]([/color][/b]entsel [color=#2f4f4f]"\nPick first curve: "[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                        [b][color=GREEN]([/color][/b]setq obj1 [b][color=BLUE]([/color][/b]vlax-ename->vla-object ent1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                [b][color=MAROON])[/color][/b]
        [b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]or [b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]getvar 'errno[b][color=BLUE])[/color][/b] 7[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]null ent1[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nYou missed, try again!"[/color][b][color=MAROON])[/color][/b] [b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]while
        [b][color=NAVY]([/color][/b]not
                [b][color=MAROON]([/color][/b]and
                        [b][color=GREEN]([/color][/b]setq ent2 [b][color=BLUE]([/color][/b]car [b][color=RED]([/color][/b]entsel [color=#2f4f4f]"\nPick second curve: "[/color][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                        [b][color=GREEN]([/color][/b]setq obj2 [b][color=BLUE]([/color][/b]vlax-ename->vla-object ent2[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                        [b][color=GREEN]([/color][/b]not [b][color=BLUE]([/color][/b]eq ent1 ent2[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                [b][color=MAROON])[/color][/b]
        [b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]or [b][color=GREEN]([/color][/b]= [b][color=BLUE]([/color][/b]getvar 'errno[b][color=BLUE])[/color][/b] 7[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]null ent2[b][color=GREEN])[/color][/b] [b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nYou missed, try again!"[/color][b][color=MAROON])[/color][/b] [b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setq int-lst [b][color=NAVY]([/color][/b]vlax-safearray->list [b][color=MAROON]([/color][/b]vlax-variant-value [b][color=GREEN]([/color][/b]vla-IntersectWith obj1 obj2 acExtendNone[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setq cnt [b][color=NAVY]([/color][/b]- 1[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]foreach x int-lst
        [b][color=NAVY]([/color][/b]if
                [b][color=MAROON]([/color][/b]and 
                        [b][color=GREEN]([/color][/b]setq pt [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]nth [b][color=PURPLE]([/color][/b]setq cnt [b][color=TEAL]([/color][/b]+ cnt 1[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] int-lst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]nth [b][color=PURPLE]([/color][/b]setq cnt [b][color=TEAL]([/color][/b]+ cnt 1[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] int-lst[b][color=RED])[/color][/b] [b][color=RED]([/color][/b]nth [b][color=PURPLE]([/color][/b]setq cnt [b][color=TEAL]([/color][/b]+ cnt 1[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] int-lst[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                        [b][color=GREEN]([/color][/b]car pt[b][color=GREEN])[/color][/b] [color=#8b4513]; X check[/color]
                        [b][color=GREEN]([/color][/b]cadr pt[b][color=GREEN])[/color][/b] [color=#8b4513]; Y check[/color]
                        [b][color=GREEN]([/color][/b]caddr pt[b][color=GREEN])[/color][/b] [color=#8b4513]; Z check[/color]
                [b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]setq pt-lst [b][color=GREEN]([/color][/b]cons pt pt-lst[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
        [b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]setq pt-lst [b][color=NAVY]([/color][/b]reverse pt-lst[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]progn
        [b][color=NAVY]([/color][/b]setvar 'PDMODE 35[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]foreach x pt-lst
                [b][color=MAROON]([/color][/b]if x
                        [b][color=GREEN]([/color][/b]progn
                                [b][color=BLUE]([/color][/b]entmakex [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]cons 0 [color=#2f4f4f]"POINT"[/color][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]cons 10 x[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]cons 62 1[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                                [b][color=BLUE]([/color][/b]princ [color=#2f4f4f]"\n"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]print x[b][color=BLUE])[/color][/b] 
                        [b][color=GREEN])[/color][/b]
                [b][color=MAROON])[/color][/b]
                
        [b][color=NAVY])[/color][/b]
[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]princ[b][color=FUCHSIA])[/color][/b]
[b][color=BLACK])[/color][/b][color=#8b4513];defun        [/color]

; Prompts for a SS (either implied or user) until theres one:
(defun C:test ( / SS SSloop lst assoc-lst cnt )
(setq SSloop T)
(while SSloop
        (if (not (setq SS (ssget "_I")))
                        (setq SS (ssget "_:L"))
                        (sssetfirst nil nil)
        )
        (if (and SS (>= (sslength SS) 1))
                (progn
                        (setq lst (ss->lst SS))
                        (setq assoc-lst (combine-itms lst))
                        (print assoc-lst)
                        (setq cnt 0)
                        (repeat (length assoc-lst)
                                (ins-pt (car (nth cnt assoc-lst)) (cdr (nth cnt assoc-lst)) )
                                (setq cnt (+ cnt 1))
                        )
                        (setq SSloop nil)
                )
        )
)
(princ)
)
(defun ss->lst (ss / i l)
(if (eq (type ss) 'pickset)
        (repeat (setq i (sslength ss))
        (setq l (cons (ssname ss (setq i (1- i))) l))
        )
)
)
; So this is the source list: A B C D
; The result should be like this: (("A" . "B") ("A" . "C") ("A" . "D") ("B" . "C") ("B" . "D") ("C" . "D"))
; So there would be combination between every 2 items
(defun combine-itms ( lst / oldlst newlst cnt itm )
; (setq lst (list "A" "B" "C" "D"))
         (setq oldlst lst)
(setq newlst (list)) ; the result should be: AB AC AD BC BD CD
(setq cnt 0) ; set a counter
(while (> (length lst) 0) ; repeat until all the items are removed from the list
        (foreach x oldlst ; iterate trough the list
                (if 
                        (and 
                                (not (eq (nth cnt lst) x)) ; check if the current item doesnt duplicate itself (example result would be: AA BB CC DD)
                                (not (member (cons (nth cnt lst) x) newlst ))
                                (not (member (cons x (nth cnt lst)) newlst ))
                                lst ; check if the lst is not nil
                        ) 
                        (progn
                                (setq itm 
                                        (cons 
                                                (nth cnt lst) ; the current item
                                                x ; iteration item
                                        )
                                ) ; combined item
                                (setq newlst (cons itm newlst)) ; add the combined item in a new list
                                
                        )
                )
                
        ); foreach
          (setq lst (remove_nth lst cnt)) ; returns the same list without the item on "cnt" position (redefine the list)
        ;(setq cnt (+ cnt 1)) ; increment the counter
); repeat
(setq newlst (reverse newlst))
; (print newlst)
; (princ)
)
; LM - remove nth (returns the same list with the removed item):
(defun remove_nth ( lst n / lstn )
(setq n (1+ n))
(foreach x lst (if (/= 0 (setq n (1- n))) (setq lstn (cons x lstn))))
(reverse lstn)
)                
(defun ins-pt ( ent1 ent2 / obj1 obj2 int-lst cnt pt pt-lst )
                        ; (setq ent1 (car (entsel "\nPick first curve: ")))
                        (setq obj1 (vlax-ename->vla-object ent1))
                        ; (setq ent2 (car (entsel "\nPick second curve: ")))
                        (setq obj2 (vlax-ename->vla-object ent2))
(setq int-lst (vlax-safearray->list (vlax-variant-value (vla-IntersectWith obj1 obj2 acExtendNone))))
(setq cnt (- 1))
(foreach x int-lst
        (if
                (and 
                        (setq pt (list (nth (setq cnt (+ cnt 1)) int-lst) (nth (setq cnt (+ cnt 1)) int-lst) (nth (setq cnt (+ cnt 1)) int-lst)))
                        (car pt) ; X check
                        (cadr pt) ; Y check
                        (caddr pt) ; Z check
                )
                (setq pt-lst (cons pt pt-lst))
        )
)
(setq pt-lst (reverse pt-lst))
(progn
        (setvar 'PDMODE 35)
        (foreach x pt-lst
                (if x
                        (progn
                                (entmakex (list (cons 0 "POINT") (cons 10 x) (cons 62 1)))
                                ; (princ "\n")(print x) 
                        )
                )
                
        )
)
(princ)
);defun