Topic: subtracting vertices of group of polylines

[bprabhakar001]

Dear All,

I have a written a program to identify the vertices which are not identical from overlapping each polylines.
But it gives peculate result. I did not have where exactly problem exist.
Would you please some one help me to rectify the problem. And also I requesting you please suggest the method to solve this. Because if the dwg having more data it was taking couple of processing time some time hanging also.
I am very glad to here the corrections.

Thanking U,
Prabhakar.B

<contact information removed>

[ElpanovEvgeniy]

Code: [Select]

(defun c:test-lw (/ a1 a2 l)
  (if (and (setq a1 (ssget "_X" '((0 . "POLYLINE,LWPOLYLINE") (8 . "*Trails Routes_*"))))
           (setq a2 (ssget "_X" '((0 . "POLYLINE,LWPOLYLINE") (8 . "*Trails_*"))))
      ) ;_  and
    (progn
      (setq a1 (mapcar (function cadr) (ssnamex a1))
            a2 (mapcar (function cadr) (ssnamex a2))
      ) ;_  setq
      (progn
        (foreach x a1
          (foreach x1 a2
            (if
              (and (equal (distance (vlax-curve-getclosestpointto x (vlax-curve-getStartPoint x1))
                                    (vlax-curve-getStartPoint x1)
                          ) ;_  distance
                          0.
                          1e-8
                   ) ;_  equal
                   (equal (distance (vlax-curve-getclosestpointto x (vlax-curve-getEndPoint x1))
                                    (vlax-curve-getEndPoint x1)
                          ) ;_  distance
                          0.
                          1e-8
                   ) ;_  equal
              ) ;_  and
               (progn
                 (setq a2 (vl-remove x1 a2))
                 (foreach x2 (mapcar
                               (function cdr)
                               (vl-remove-if-not (function (lambda (b) (= (car b) 10))) (entget x1))
                             ) ;_  mapcar
                   (if (not (equal (distance (vlax-curve-getclosestpointto x x2) x2)
                                   0.
                                   1e-8
                            ) ;_  equal
                       ) ;_  not
                     (setq l (cons x2 l))
                   ) ;_  if
                 ) ;_  foreach
               ) ;_  progn
            ) ;_  if
          ) ;_  foreach
        ) ;_  foreach
        (foreach x a1
          (foreach x2 l
            (if (equal (distance (vlax-curve-getclosestpointto x x2) x2) 0. 1e-8)
              (setq l (vl-remove x2 l))
            ) ;_  if
          ) ;_  foreach
        ) ;_  foreach
        (foreach x l
          (entmakex
            (list
              '(0 . "CIRCLE")
              '(8 . "ERROR-DIST")
              '(62 . 1)
              (cons 10 x)
              '(40 . 0.0005)
            ) ;_  list
          ) ;_  entmakex
        ) ;_  foreach
      ) ;_  progn
    ) ;_  progn
  ) ;_  if
  (princ)
)

[CAB]

Evgeniy you beat me to it.

Here is my attempt.

Code: [Select]

(defun c:ver (/ echo osmode)
  (vl-load-com)

  (defun getlwpolylinecoords (ent / idx pt result)
    (setq idx -1)
    (while (setq pt (vlax-curve-getpointatparam ent (setq idx (1+ idx))))
      (setq result (cons pt result))
    )
    (reverse result)
  )

  (defun get_vertex (lyr / ss coor result)
    (if (setq ss (ssget "_X" (list '(0 . "POLYLINE,LWPOLYLINE") (cons 8 lyr))))
      (mapcar '(lambda (x)
                 (if (setq coor (getlwpolylinecoords x))
                   (if result
                     (setq result (append coor result))
                     (setq result coor)
                   )
                 )
               )
              (mapcar 'cadr
                      (ssnamex ss)
              )

      )
    )
    result
  )

  ;;  Subtract two point list given a max distance
  ;;  CAB 08/26/2006
  (defun return_unique_points (lst1 lst2 max_distance / tmp)
    (setq tmp lst2)
    (mapcar
      '(lambda (x)
         (setq lst2 (vl-remove-if '(lambda (y) (< (distance x y) max_distance)) lst2))
       )
      lst1
    )
    (mapcar
      '(lambda (x)
         (setq lst1 (vl-remove-if '(lambda (y) (< (distance x y) max_distance)) lst1))
       )
      tmp
    )
    (append lst2 lst1)
  )


  (defun mark (lst r)
    (mapcar
      '(lambda (pt)
         (entmake
           (list (cons 0 "CIRCLE")
                 (cons 6 "BYLAYER")
                 (cons 8 "ERROR")
                 (cons 10 pt)
                 (cons 40 r)
                 (cons 62 1) ; RED
                 (cons 210 (list 0.0 0.0 1.0))
           )
         )
       )
      lst
    )
  )




  ;;------------------------------------------
  ;;  Begin Here
  ;;------------------------------------------

  (command "undo" "be")
  (setq echo   (getvar "cmdecho")
        osmode (getvar "osmode")
  )
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)


  (setq rad 0.0004) ; Circle for test
  (setq max_dist 0.0000001) ; **  max distance for error of points

  (if
    (and
      (or (setq trail (get_vertex "*TRAIL*"))
          (prompt "\nNo trail features selected\n")
      )
      (or (setq route (get_vertex "*ROUTE*"))
          (prompt "\nNo route features selected\n")
      )
    )
    (progn
      (prompt "\n * * * Working, Please Wait........\n")
     (if (setq mis_match (return_unique_points trail route max_dist))
       (mark mis_match rad)
     )
      )
  )
  (setvar "CMDECHO" echo)
  (setvar "OSMODE" osmode)
  (command "undo" "end")
  (princ)
)
;;===============================================================================;;

(repeat 3 (print))
(princ
  "\n\t\lsp loaded.............Proceed with \"VER\"."
)
(princ)

[ElpanovEvgeniy]

Evgeniy you beat me to it.

Here is my attempt.

Excuse! I did not wish to offend. 
I probably have hastened, I needed to wait for all a floor of hour...

[CAB]

Evgeniy
You did not offend me. I was joking around.
I enjoy all your post and learn from them, thanks for participating, and keep up the good work.

Alan

[ElpanovEvgeniy]

Evgeniy
You did not offend me. I was joking around.
I enjoy all your post and learn from them, thanks for participating, and keep up the good work.

Alan

Alan
I too study, but already for you! 

[bprabhakar001]

Thanking you both,

Mr. Cab your program is giving exact results what am I trying.
At the same time Mr.ElpanovEvgeniy program is running with superb fast. But it was giving errors only where trail vertex differing.
It is fails when overlapping route missing/extra vertex in route list.

Thanking you very much. I am trying to get such a speed from ElpanovEvgeniy program and the desired results from Mr. Cab.

I requesting you please guide me.

Thanking you,
Prabhakar.B

[ElpanovEvgeniy]

Thanking you both,

Mr. Cab your program is giving exact results what am I trying.
At the same time Mr.ElpanovEvgeniy program is running with superb fast. But it was giving errors only where trail vertex differing.
It is fails when overlapping route missing/extra vertex in route list.

Thanking you very much. I am trying to get such a speed from ElpanovEvgeniy program and the desired results from Mr. Cab.

I requesting you please guide me.

Thanking you,
Prabhakar.B

Code: [Select]

(defun c:test-lw (/ a1 a2 x)
  (if (and (setq a1 (ssget "_X" '((0 . "POLYLINE,LWPOLYLINE") (8 . "*Trails Routes_*"))))
           (setq a2 (ssget "_X" '((0 . "POLYLINE,LWPOLYLINE") (8 . "*Trails_*"))))
      ) ;_  and
    (progn
      (setq a1 (mapcar (function cadr) (ssnamex a1))
            a2 (mapcar
                 (function
                   (lambda (x / e i l)
                     (setq e (vlax-curve-getEndParam x)
                           i 0
                     ) ;_  setq
                     (while (< i e)
                       (setq l (cons (vlax-curve-getPointAtParam x i) l)
                             i (+ i 0.5)
                       ) ;_  setq
                     ) ;_  while
                     l
                   ) ;_  lambda
                 ) ;_  function
                 (mapcar (function cadr) (ssnamex a2))
               ) ;_  mapcar
      ) ;_  setq
      (foreach x a1
        (setq a2
               (vl-remove-if
                 (function null)
                 (mapcar
                   (function
                     (lambda (x2)
                       (while
                         (and
                           (car x2)
                           (equal (distance (vlax-curve-getclosestpointto x (car x2))
                                            (car x2)
                                  ) ;_  distance
                                  0.
                                  1e-8
                           ) ;_  equal
                         ) ;_  and
                          (setq x2 (cdr x2))
                       ) ;_  while
                       (vl-remove-if (function null) x2)
                     ) ;_  lambda
                   ) ;_  function
                   a2
                 ) ;_  mapcar
               ) ;_  vl-remove-if
        ) ;_  setq
      ) ;_  foreach
      (setq a2 (apply (function append) a2))
      (foreach x a1
        (foreach x2 a2
          (if (equal (distance (vlax-curve-getclosestpointto x x2) x2) 0. 1e-8)
            (setq a2 (vl-remove x2 a2))
          ) ;_  if
        ) ;_  foreach
      ) ;_  foreach
      (foreach x a2
        (entmakex
          (list
            '(0 . "CIRCLE")
            '(8 . "ERROR-DIST")
            '(62 . 1)
            (cons 10 x)
            '(40 . 0.0005)
          ) ;_  list
        ) ;_  entmakex
      ) ;_  foreach
    ) ;_  progn
  ) ;_  if
  (princ)
)

[Hangman]

Wow !!!  You guys are good !!!    :kewl:

[bprabhakar001]

Dear All,

I am afraid am unable to find the some of the attached referenced dwg.
I requesting you please kindly resolve that.

Thanking you,
Prabhakar.B

[ElpanovEvgeniy]

Dear All,

I am afraid am unable to find the some of the attached referenced dwg.
I requesting you please kindly resolve that.

Thanking you,
Prabhakar.B

Only as an example...

Code: [Select]

(defun c:test-lw (/ A1 A2 P X)
  (if (and (setq a1 (ssget "_X" '((0 . "POLYLINE,LWPOLYLINE") (8 . "*Trails Routes_*"))))
           (setq a2 (ssget "_X" '((0 . "POLYLINE,LWPOLYLINE") (8 . "*Trails_*"))))
      )
    (foreach x (del-pt1
                 (mapcar
                   (function cdr)
                   (vl-remove-if-not
                     (function
                       (lambda (b)
                         (= (car b) 10)
                       ) ;_  lambda
                     ) ;_  function
                     (apply
                       (function append)
                       (mapcar
                         (function entget)
                         (mapcar (function cadr) (ssnamex a1))
                       ) ;_  mapcar
                     ) ;_  apply
                   ) ;_  vl-remove-if-not
                 ) ;_  mapcar
                 (mapcar
                   (function cdr)
                   (vl-remove-if-not
                     (function
                       (lambda (b)
                         (= (car b) 10)
                       ) ;_  lambda
                     ) ;_  function
                     (apply
                       (function append)
                       (mapcar
                         (function entget)
                         (mapcar (function cadr) (ssnamex a2))
                       ) ;_  mapcar
                     ) ;_  apply
                   ) ;_  vl-remove-if-not
                 ) ;_  mapcar
               ) ;_  del-pt1
      (entmakex
        (list
          '(0 . "CIRCLE")
          '(8 . "ERROR-DIST")
          '(62 . 1)
          (cons 10 x)
          '(40 . 0.0005)
        ) ;_  list
      ) ;_  entmakex
    ) ;_  foreach
  ) ;_  if
  (princ)
) ;_  defun
     
(defun del-pt1 (lst1 lst2)
  (if (and lst1 lst2)
    (if (vl-member-if
          (function
            (lambda (a)
              (equal (distance (car lst2) a) 0. 1e-8)
            ) ;_  lambda
          ) ;_  function
          lst1
        ) ;_  vl-member-if
      (del-pt1
        (vl-remove-if
          (function
            (lambda (a)
              (equal (distance (car lst2) a) 0. 1e-8)
            ) ;_  lambda
          ) ;_  function
          lst1
        ) ;_  vl-remove-if
        (vl-remove-if
          (function
            (lambda (a)
              (equal (distance (car lst2) a) 0. 1e-8)
            ) ;_  lambda
          ) ;_  function
          (cdr lst2)
        ) ;_  vl-remove-if
      ) ;_  del-pt1
      (cons
        (car lst2)
        (del-pt1
          (vl-remove-if
            (function
              (lambda (a)
                (equal (distance (car lst2) a) 0. 1e-8)
              ) ;_  lambda
            ) ;_  function
            lst1
          ) ;_  vl-remove-if
          (vl-remove-if
            (function
              (lambda (a)
                (equal (distance (car lst2) a) 0. 1e-8)
              ) ;_  lambda
            ) ;_  function
            (cdr lst2)
          ) ;_  vl-remove-if
        ) ;_  del-pt1
      ) ;_  cons
    ) ;_  if
    (if (or lst1 lst2)(append lst1 lst2))
  ) ;_  if
) ;_  defun



[bprabhakar001]

Great, I appreciate your efforts. I don’t' know how can I useful for u my friend.

Thanking you very much you and to this Org.

I will upload all the source code what am I having since 6 years. Any one could help to commenting or functions separation is welcome.

Best Regards,
Prabhakar.B

[ElpanovEvgeniy]

Great, I appreciate your efforts. I don’t' know how can I useful for u my friend.

Thanking you very much you and to this Org.

I will upload all the source code what am I having since 6 years. Any one could help to commenting or functions separation is welcome.

Best Regards,
Prabhakar.B

I today have spent only 10 minutes for your problem...