Nhờ Các Cao Thủ Giúp Mình Thêm Point Vào Giao Điểm Các Pline

[CAD_vimsat 2]

[Yêu Cầu]Mình có các đường pline giao nhau xin nhờ các cao thủ giúp mình viết lisp hộ:

1: Thêm các point đó vào giao điểm các đường pline

2: Chiếu hoặc move các giao điểm đó lên một đường thẳng...

Mình cảm ơn các cao thủ nhiều  :)

[CAD_vimsat 2]

có ai giúp mình với?

[trandangquang92 17]

bạn phải trình bày dưới dạng hình ảnh ý tưởng hoặc đính kèm cad, chứ k hiểu ý tưởng sao giúp

[Doan Van Ha 3.191]

Này bạn! Chú ý: Line AB phải đủ dài để hình chiếu luôn nằm trong AB, nếu không thì phải sửa lisp tí. 

(defun C:HA(/ ss ln lst)
 (defun #Inter:1SS(ss / a b i j l)
  (repeat (setq i (sslength ss))
   (setq a (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
   (repeat (setq j i)
    (setq b (vlax-ename->vla-object (ssname ss (setq j (1- j)))) l (cons (#Inter:2Obj a b acExtendNone) l))))
  (apply 'append (reverse l)))
 (defun #Inter:2Obj(obj1 obj2 flag / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 flag))
  (repeat (/ (length l) 3)
   (setq r (cons (list (car l) (cadr l) (caddr l)) r) l (cdddr l)))
  (reverse r))
 (defun MPoint (pt) (entmake (list (cons 0 "POINT") (cons 10 pt))))
 (princ "\nChon cac Pline...")
 (if
  (and
   (setq ss (ssget '((0 . "*line"))))
   (setq ln (car (entsel "\nChon Line de chieu hoac move: "))))
  (progn 
   (initget "C M")
   (setq wd (getkword "\nChon hinh thuc [Chieu/Move] <M>: "))
   (setq lst (#Inter:1SS ss))
   (cond
    ((or (= wd "M") (not wd)) (mapcar '(lambda(pt) (Mpoint (vlax-curve-getClosestPointTo ln pt))) lst))
    ((= wd "C") (mapcar '(lambda(pt) (Mpoint pt) (Mpoint (vlax-curve-getClosestPointTo ln pt))) lst)))))
 (princ))