[编程交流] 沿两条线的连接点

(defun c:test (/ a b lst1 lst2)
 
   ;;; listpol   by Gille Chanteau                                            ;
   ;;; Returns the vertices list of any type of polyline (WCS coordinates)    ;
   ;;;                                                                        ;
   ;;; Argument                                                               ;
   ;;; en, a polyline (ename or vla-object)                                   ;
   (defun listpol (en / i p l)  
      (setq i (if (vlax-curve-IsClosed en)
                  (vlax-curve-getEndParam en)
         (+ (vlax-curve-getEndParam en) 1)
      )
      )              
      (while (setq p (vlax-curve-getPointAtParam en (setq i (1- i))))
        (setq l (cons (trans p 0 1 ) l))
      )
   )
  ;---------------------------------------------------------------------------------;
   (setq lst1 (listpol (car (entsel "\Select First Polyline: ")))
  lst2 (listpol (car (entsel "\Select Second Polyline: ")))
   )
   (mapcar '(lambda (a b) (entmakex (list (cons 0  "LINE")
                                   (cons 10 a)
                                   (cons 11 b)
                             )
                   )
      ) lst1 lst2)
)

(defun c:joinpt (/ a b en1 en2 enl1 enl2 flt lst1 lst2 p)
  ;;*************************************************************************;
  ;; getfencesel        by ymg                                               ;
  ;;                                                                         ;
  ;; Arguments:  en,  Linear Entity Name (Polylines, Arc, Ellipse etc.)      ;
  ;;            flt,  A valid Entity filer Ex: '((0 . "3DFACE"))  or nil     ;
  ;;                                                                         ;
  ;;   Returns: A Selection Set of Entities touching the selecting entity.   ;
  ;;                                                                         ;
  ;;  Requires: Express Tools                                                ;
  ;;*************************************************************************;
  (defun getfencesel (en flt / fe px ss)    
     (acet-ss-zoom-extents (setq ss (ssadd en)))
     (setq px (* 0.75 (acet-geom-pixel-unit))
           fe (acet-list-remove-adjacent-dups (acet-geom-object-point-list en (/ px 2.0)))
           ss (if flt (ssget "_F" fe flt) (ssget "_F" fe))
     )      
  )
  ;;*************************************************************************;
  ;; mk_lwp    by Alan J Thompson                                            ;
  ;; Argument: pl, A list of points (2d or 3d)                               ;
  ;; Create an LWPolyline at Elevation 0, on Current Layer.                  ;
  ;; Return: Polyline Object                                                 ;
  ;;*************************************************************************;
  (defun mk_lwp (pl)
     (vlax-ename->vla-object
        (entmakex
          (append (list '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                         (cons 90 (length pl))
                        '(70 . 0)
                  )
                  (mapcar '(lambda (p) (cons 10 (trans (list (car p) (cadr p)) 1 0))) pl)
          )
       )
     )
  )
  (setq en1 (car (entsel "\nSelect First Polyline: "))
 en2 (car (entsel "\nSelect Second Polyline: "))
 flt '((0 . "POINT"))
       enl1 (acet-ss-to-list (getfencesel en1 flt))
enl2 (acet-ss-to-list (getfencesel en2 flt))
 
  )
  (setq lst1 nil lst2 nil)
  (foreach e enl1
     (setq lst1 (cons (cdr (assoc 10 (entget e))) lst1))
  )            
  (foreach e enl2
     (setq lst2 (cons (cdr (assoc 10 (entget e))) lst2))
  )
  (mapcar '(lambda (a b) (mk_lwp (list a b))) lst1 lst2)
  (princ)
)