Topic: add vertex help

[csgoh]

I got the mext function from this forum and I am modifying to add vertices to the polyline. One of the condition is that if the intersection point of the lines and the polyline has a vertex, subject to a fuzz, then the vertex is not created. If not then add a new vertex. The function I created do not seem to do it.
Hope some gurus can help me out.

Code: [Select]

(defun c:mext (/ ang c e lines lwp lyr ptlst pts ss pt1 param)
  (if (setq ss (ssget ":L" '((0 . "LWPOLYLINE,LINE,SPLINE"))))
    (progn (mapcar '(lambda (e)
      (if (wcmatch (cdr (assoc 0 (entget e))) "LINE")
(setq lines (cons e lines))
(setq lwp (cons e lwp))
      )
)
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
   (if (and lwp lines)
     (foreach l (mapcar 'vlax-ename->vla-object lines)
       (setq ang   (vla-get-angle l)
     lyr   (vla-get-layer l)
     ptlst nil
       )
;;;
       (foreach pl (mapcar 'vlax-ename->vla-object lwp)
     (if (and (vlax-property-available-p pl 'closed)
        (zerop (vlax-get pl 'closed))
        (setq c t)
         )
          (vlax-put pl 'closed -1)
     )
(if (setq pts (vlax-invoke l 'intersectwith pl acextendthisentity))
  (progn
      (while pts
 (setq ptlst (cons (setq aPt (list (car pts) (cadr pts))) ptlst))
;;
        (setq param (vlax-curve-getParamAtPoint
                          (vlax-vla-object->ename pl)(car ptlst)))
(setq pt1 (vlax-curve-getpointatparam (vlax-vla-object->ename pl) (fix param)))
(setq pt2 (vlax-curve-getpointatparam (vlax-vla-object->ename pl) (fix (1+ param))))



         (cond
          ((and param (> param (fix param)) (equal (- param (fix param)) 1.0 0.00000005))
           (vlax-invoke pl 'addvertex (+ (fix param) 1)aPt)           
          )
          ((and param (>= (- param (fix param))0.0000005))
           (vlax-invoke pl 'addvertex (+ (fix param) 1)aPt)           
          )
         );cond
;;
        (setq pts (cdddr pts))
)
   )
)
(if c
   (progn (vlax-put pl 'closed 0) (setq c nil))
)
       );foreach pl
;;;
       (if ptlst
(progn
              (setq ptlst (vl-sort ptlst
     (function (lambda (d1 d2)
(if (equal ang 0.0 pi)
   (> (car d1) (car d2))
   (< (cadr d1) (cadr d2))
)
       )
     )
    )
)
(while ptlst
  (entmakex (list '(0 . "LINE")
  (cons 8 lyr)
  (cons 10 (car ptlst))
  (cons 11 (cadr ptlst))
    )
  )

  (setq ptlst (cddr ptlst))
)
(vla-delete l)
)
       )
     )
   )
    )
  )
  (princ)
)


[csgoh]

I tried 2 different approach and got two different results.
In the first approach, I compare the distance using >= while the second one using <= and I got 2 results as in the dwg attached.
I could not figure out what is wrong.hope someone can enlighten me
first approach

Code: [Select]

(defun c:mext1 (/ ang c e lines lwp lyr ptlst pts ss pt1 pt2 apt param)
  (if (setq ss (ssget ":L" '((0 . "LWPOLYLINE,LINE"))))
    (progn (mapcar '(lambda (e)
      (if (wcmatch (cdr (assoc 0 (entget e))) "LINE")
(setq lines (cons e lines))
(setq lwp (cons e lwp))
      )
)
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
   (if (and lwp lines)
     (foreach l (mapcar 'vlax-ename->vla-object lines)
       (setq ang   (vla-get-angle l)
     lyr   (vla-get-layer l)
     ptlst nil
       )
;;;
       (foreach pl (mapcar 'vlax-ename->vla-object lwp)
     (if (and (vlax-property-available-p pl 'closed)
        (zerop (vlax-get pl 'closed))
        (setq c t)
         )
          (vlax-put pl 'closed -1)
     )
(if (setq pts (vlax-invoke l 'intersectwith pl acextendthisentity))
  (progn
      (while pts
 (setq ptlst (cons (setq aPt (list (car pts) (cadr pts))) ptlst))
;;
        (setq param (vlax-curve-getParamAtPoint
                          (vlax-vla-object->ename pl)(car ptlst)))
(setq pt1 (vlax-curve-getpointatparam (vlax-vla-object->ename pl) (fix param)))
(setq pt2 (vlax-curve-getpointatparam (vlax-vla-object->ename pl) (fix (1+ param))))


[color=red]        (if param
            (progn
              (if (or (>= (distance apt pt1) 0.0005)
                      (>= (distance apt pt2) 0.0005)
                  )
                  (vlax-invoke pl 'addvertex (+ (fix param) 1)aPt)
                  (print "no new vertex")
              );if[/color]                 
            )
        )
;;
        (setq pts (cdddr pts))
)
   )
)
(if c
   (progn (vlax-put pl 'closed 0) (setq c nil))
)
       );foreach pl
;;;
       (if ptlst
(progn
              (setq ptlst (vl-sort ptlst
     (function (lambda (d1 d2)
(if (equal ang 0.0 pi)
   (> (car d1) (car d2))
   (< (cadr d1) (cadr d2))
)
       )
     )
    )
)
(while ptlst
  (entmakex (list '(0 . "LINE")
  (cons 8 lyr)
  (cons 10 (car ptlst))
  (cons 11 (cadr ptlst))
    )
  )

  (setq ptlst (cddr ptlst))
)
(vla-delete l)
)
       )
     )
   )
    )
  )
  (princ)
)
second approach

Code: [Select]

(defun c:mext2 (/ ang c e lines lwp lyr ptlst pts ss pt1 pt2 apt param)
  (if (setq ss (ssget ":L" '((0 . "LWPOLYLINE,LINE"))))
    (progn (mapcar '(lambda (e)
      (if (wcmatch (cdr (assoc 0 (entget e))) "LINE")
(setq lines (cons e lines))
(setq lwp (cons e lwp))
      )
)
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    )
   (if (and lwp lines)
     (foreach l (mapcar 'vlax-ename->vla-object lines)
       (setq ang   (vla-get-angle l)
     lyr   (vla-get-layer l)
     ptlst nil
       )
;;;
       (foreach pl (mapcar 'vlax-ename->vla-object lwp)
     (if (and (vlax-property-available-p pl 'closed)
        (zerop (vlax-get pl 'closed))
        (setq c t)
         )
          (vlax-put pl 'closed -1)
     )
(if (setq pts (vlax-invoke l 'intersectwith pl acextendthisentity))
  (progn
      (while pts
 (setq ptlst (cons (setq aPt (list (car pts) (cadr pts))) ptlst))
;;
        (setq param (vlax-curve-getParamAtPoint
                          (vlax-vla-object->ename pl)(car ptlst)))
(setq pt1 (vlax-curve-getpointatparam (vlax-vla-object->ename pl) (fix param)))
(setq pt2 (vlax-curve-getpointatparam (vlax-vla-object->ename pl) (fix (1+ param))))


[color=red]        (if param
            (progn
              (if (or (<= (distance apt pt1) 0.0005)
                      (<= (distance apt pt2) 0.0005)
                  )
                  (print "no new vertex")
                   (vlax-invoke pl 'addvertex (+ (fix param) 1)aPt)
              );if[/color]                 
            )
        )
;;
        (setq pts (cdddr pts))
)
   )
)
(if c
   (progn (vlax-put pl 'closed 0) (setq c nil))
)
       );foreach pl
;;;
       (if ptlst
(progn
              (setq ptlst (vl-sort ptlst
     (function (lambda (d1 d2)
(if (equal ang 0.0 pi)
   (> (car d1) (car d2))
   (< (cadr d1) (cadr d2))
)
       )
     )
    )
)
(while ptlst
  (entmakex (list '(0 . "LINE")
  (cons 8 lyr)
  (cons 10 (car ptlst))
  (cons 11 (cadr ptlst))
    )
  )

  (setq ptlst (cddr ptlst))
)
(vla-delete l)
)
       )
     )
   )
    )
  )
  (princ)
)

Function mext1 and mext2 are the same except those in red. Hope some guru can help out
thank you.