troubleshooting autolisp routine

[arefemami98]

Hi everyone, i have lots of drawings that each of them has hundreds of polylines, some of these polylines have vertices that share the same exact coordinate witch is fine but some of them were supposed to do that but because drawing imperfections there is a slight gap between them (basically two different polylines were supposed to touch at one or more vertices but they didn't snap together perfectly)
I wrote a basic autolisp script that was supposed to take the polylines and look for vortices that are very close and snaps them together but it seems it doesn't work and i belive the snapvertex subroutine is not working, i really appreciate if someone could help me troubleshoot it
thank you

(defun c:SnapVerts ( / ss fuzz i j ent1 ent2 vlist1 vlist2 v1 v2 d)

  ;Get list of vertices from polyline

(defun getvertices (ent / elist n vlist)

  (setq elist (entget ent)

        n     (cdr (assoc 90 elist)) ; number of vertices

        vlist '()

  )

  (repeat n

    (setq vlist (cons (cdr (assoc 10 elist)) vlist))

    (setq elist (cdr (member (assoc 10 elist) elist)))

  )

  (reverse vlist)

)

;Reposition a vertex in polyline

(defun setvertex (ent old new / edata)

  (setq edata (entget ent))

  (setq edata

    (mapcar

      (function

        (lambda (x)

          (if (and (= (car x) 10) (= (cdr x) old))

            (cons 10 new)

            x

          )

        )

      )

      edata

    )

  )

  (entmod edata)

  (entupd ent)

)

  (setq fuzz 0.1) ; fuzz distance

  (prompt "\nSelect polylines to process: ")

  (setq ss (ssget '((0 . "LWPOLYLINE"))))

  (if ss

    (progn

      (repeat (setq i 0)

        (setq ent1 (ssname ss i))

        (setq vlist1 (getvertices ent1))

        (setq j (+ i 1))

        (while (< j (sslength ss))

          (setq ent2 (ssname ss j))

          (setq vlist2 (getvertices ent2))

          (foreach v1 vlist1

            (foreach v2 vlist2

              (setq d (distance v1 v2))

              (if (< d fuzz)

                (progn

                  (setvertex ent2 v2 v1)

                )

              )

            )

          )

          (setq j (1+ j))

        )

        (setq i (1+ i))

      )

      (princ "\nVertices snapped based on proximity.")

    )

    (prompt "\nNo polylines selected.")

  )

  (princ)

)

[Moshe-A]

@arefemami98  hi,

check this SNAPVERTS2 command.

your problem is: you do not have  control which pline vertex is moving.

in the following program the plines is gathered to a list and the iteration goes...

1st   iteration: first item v second item

2nd iteration:  second item v third item

.....

at any iteration the second is moving towards first

is this ok with you?

enjoy

Moshe

(defun c:snapVerts2 (/ _geometric _addindex _hasGap 		; local functions
		       FAZZ ss0 entities^ ctr AcDbPline0 AcDbPline1	; local variables
		       pts0 pts1 itm0 itm1 coords newCoords)		; local variables

 (defun _geometric (ent)
  (mapcar
   'cdr
    (vl-remove-if-not
      (function
        (lambda (e)
          (= (car e) 10)
        ); lambda
      ); function
      (entget ent)
    ); vl-remove-if
  ); mapcar
 ); _geometric

  
 (defun _addindex (pts / i)
  (setq i -1)
  (mapcar
    (function
      (lambda (pt)
       (setq i (1+ i)) 
       (list pt i)
      ); lambda
    ); function
    pts
  ); mapcar
 ); _addindex

  
 (defun _hasGap (vert pts1)
   (vl-some
     (function
       (lambda (itm1)
        (if (equal (distance vert (car itm1)) 0.0 FAZZ)
         itm1)
       ); lambda
     ); function
     pts1
   ); vl-some
 ); isClose_points
 
       
 ; here start c:sanpverts
 (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startUndoMark adoc)
  
 (setq FAZZ 1e-1) ; = 0.1

 (if (setq ss0 (ssget '((0 . "lwpolyline"))))
  (progn
   (setq entities^ (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss0))))
   (setq ctr 0)
   (vl-every
     (function
       (lambda (ename0 ename1)
	(setq AcDbPline0 (vlax-ename->vla-object ename0))
	(setq AcDbPline1 (vlax-ename->vla-object ename1))
	 
        (setq pts0 (_addindex (_geometric ename0)))
	(setq pts1 (_addindex (_geometric ename1)))

	(foreach itm0 pts0
         (if (setq itm1 (_hasGap (car itm0) pts1))
          (progn
	   (setq coords (car itm0))
           (setq newCoord (vlax-make-safearray vlax-vbDouble '(0 . 1)))
           (vlax-safearray-fill newCoord (list (nth 0 coords) (nth 1 coords)))
	   (vla-put-coordinate AcDbPline1 (cadr itm1) newCoord)
	   (setq ctr (1+ ctr))
	  ); progn
	 ); if
	); forach
  
	(vlax-release-object AcDbPline1)
	(vlax-release-object AcDbPline0)
       ); lambda
     ); function
     (reverse (cdr (reverse entities^))) (cdr entities^)
   ); vl-evrey

   ; echo  results
   (cond
    ((= ctr 0)
     (prompt "\nNo vertices need align.")
    ); case
    (t
     (prompt (strcat "\n" (itoa ctr) " vertices aligned."))
    ); case
   ); cond
   
  ); progn 
 ); if

 (vla-endUndoMark adoc)
 (vlax-release-object adoc)
 
 (princ) 
); c:sanpVerts2