;|===========================================================================|
| AdVx: Seçilen Polyline nesnesinin diğer çizim nesneleriyle kesiştiği      |
|       noktalarında yeni Vertex'ler oluşturulur. işleme alınan Polyline    |
|       nesnesi içinde Arc türü segmentler olduğunda hatalı sonuç verir.    |
|       Hazırlayan: M. Şahin Güvercin  www.cizimokulu.com 08.05.2014        |
|===========================================================================|;
(defun C:AdVx  (/ BsLMsf intPoints KesNes m n NewVrtX olderr PLPoints VrtX)
  (defun myerr (errmsg)
    (if (/= errmsg "\nFunction cancelled") (prompt (strcat "\n" errmsg)))
    (command "._undo" "_e") (command "._U") (setq *error* olderr) (princ))
  (setvar "cmdecho" 0) (command "undo" "group") (vl-load-com)
  (setq olderr *error* *error* myerr) (*push-error-using-command*)
  (princ "\nİşleme alınacak Polyline nesnesini seçiniz: ")
  (while (not (setq PLineObj (ssget "+.:s" (list (cons 0 "LwPolyLine"))))))
  (setq KesNes   (ssdel (ssname PLineObj 0)
                        (ssget "x" (list (cons 0 "*Line,Arc,Circle,Ellipse"))))
        PLineObj (vlax-ename->vla-object (ssname PLineObj 0))
        PLPoints (vlax-safearray->list (vlax-variant-value
                (vlax-get-property PLineObj 'Coordinates))) m -1 n -2 VrtX nil)
  (while (< (setq n (+ n 2)) (length PLPoints))
    (if VrtX (setq VrtX (append VrtX
                         (list (list (nth n PLPoints) (nth (1+ n) PLPoints)))))
      (setq VrtX (list (list (nth n PLPoints) (nth (1+ n) PLPoints))))))
  (while (< (setq m (1+ m)) (sslength KesNes))
    (if (not (minusp (vlax-safearray-get-u-bound
                       (setq intPoints (vlax-variant-value (vla-intersectwith
           (vlax-ename->vla-object (ssname KesNes m)) PLineObj 0))) 1)))
      (progn (setq intPoints (vlax-safearray->list intPoints) n -3)
        (while (< (setq n (+ n 3)) (length intPoints))
          (setq VrtX (append VrtX
                   (list (list (nth n intPoints) (nth (1+ n) intPoints)))))))))
  (setq n -1) (while (< (setq n (1+ n)) (length VrtX))
    (setq VrtX (append (list (nth n VrtX)) (vl-remove (nth n VrtX) VrtX))))
  (setq BsLMsf (mapcar'(lambda (e)(vlax-curve-getDistAtPoint PLineObj e)) VrtX)
        VrtX   (mapcar'(lambda (e)(nth e VrtX))(vl-sort-i BsLMsf '<)))
  (setq n -1 NewVrtX nil) (while (< (setq n (1+ n)) (length VrtX))
    (if NewVrtX (setq NewVrtX (append NewVrtX (list (car (nth n VrtX)))
                                      (list (cadr (nth n VrtX)))))
      (setq NewVrtX (append (list (car (nth n VrtX)))
                            (list (cadr (nth n VrtX)))))))
  (setq VrtX (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length NewVrtX))))
        n -1) (while (< (setq n (1+ n)) (length NewVrtX))
    (vlax-safearray-put-element VrtX n (nth n NewVrtX)))
  (setq VrtX     (vlax-make-variant VrtX)
        PLineObj (entget (vlax-vla-object->ename PLineObj))
        PLineObJ (subst (cons 90 (/ (length NewVrtX) 2))
                       (assoc 90 PLineObj) PLineObj) PLineObj (entmod PLineObj)
        PLineObj (vlax-ename->vla-object (entupd (cdr (assoc -1 PLineObj)))))
  (vlax-put-property PLineObj 'Coordinates VrtX)
  (command "_.undo" "end") (setq *error* olderr) (*pop-error-mode*) (prin1))