Author Topic: Project or "glue" closed polyline edges on a nearby polyline  (Read 2115 times)

0 Members and 1 Guest are viewing this topic.

vladgothe

  • Mosquito
  • Posts: 9
Project or "glue" closed polyline edges on a nearby polyline
« on: November 14, 2014, 08:24:09 AM »
Hello everybody. I need a program which modifies a selected closed polyline, so it sticks perfectly with an overlapping neighbour polyline. I attached an example, so my request will be better understood. Thanks in advance!

ChrisCarlson

  • Guest
Re: Project or "glue" closed polyline edges on a nearby polyline
« Reply #1 on: November 14, 2014, 09:41:29 AM »
I suggest you email either

https://blackboxcad.com/Contact.html
or
http://www.lee-mac.com/contact.html

and inquire about purchasing a custom routine.

Brick_top

  • Guest
Re: Project or "glue" closed polyline edges on a nearby polyline
« Reply #2 on: November 14, 2014, 10:14:52 AM »
I tried to find a solution but to me it is difficult because in the way I'm thinking there should have to be a max tolerance for the distance between the points to be substituted.

Brick_top

  • Guest
Re: Project or "glue" closed polyline edges on a nearby polyline
« Reply #3 on: November 14, 2014, 11:01:03 AM »
this is the most I have been able to do, don't know if I'm far away from a result or not, or if I'm thinking in the best way (probably not)

but here is what I got

Code: [Select]
(defun _ListDuplicateCounter (lst / c new)
  ;; Alan J. Thompson, 06.26.10
  (foreach x lst
    (if (setq c (assoc x new))
      (setq new (subst (cons x (1+ (cdr c))) c new))
      (setq new (append new (list (cons x 1))))
    )
  )
)

(defun c:pltest ()
  (prompt "\nSelect Polyline to be changed:")
  (setq pl1 (ssget))
  (prompt "\nSelect Polyline to base from:")
  (setq pl2 (ssget))
 
  (setq lst1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget (ssname pl1 0))))
        lst2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget (ssname pl2 0))))
num 0
num1 0
clpt nil
  );setq
  (repeat (length lst2)
    (setq pt1 (nth num lst2)
  ptdst (mapcar '(lambda (x) (list (distance pt1 x) pt1 x)) lst1)
  ptdst (car (vl-sort ptdst '(lambda (x1 x2)(< (car x1)(car x2)))));first closest point
  clpt (cons ptdst clpt)
  num (+ 1 num)
    );setq
  );repeat
  (setq clpt (vl-sort clpt '(lambda (x1 x2)(< (car x1)(car x2))));group of closest points
        clpt2 (mapcar '(lambda (x) (last x)) clpt)
        clpt2 (_ListDuplicateCounter clpt2);group of vertices which closest point is the same between them
  );setq
 );defun

it only outputs a list of the number of vertices which have a common repeated closest point to the polyline to be changed.

from here I don't know what to do but to guess which ones are the least distance to a certain tolerance and replace them in the polyline to be changed.

I'm far from being an expert.

mailmaverick

  • Bull Frog
  • Posts: 494
Re: Project or "glue" closed polyline edges on a nearby polyline
« Reply #4 on: November 14, 2014, 03:52:48 PM »
Find attached my solution :-

Code: [Select]
;;; Poly-Pts (gile)
;;; Returns the vertices list of any type of polyline (WCS coordinates)
;;;
;;; Argument
;;; pl : a polyline (ename or vla-object)
(defun Poly-Pts (pl / pa pt lst)
  (vl-load-com)
  (setq pa (if (vlax-curve-IsClosed pl)
     (vlax-curve-getEndParam pl)
     (+ (vlax-curve-getEndParam pl) 1)
   )
  )
  (while (setq pt (vlax-curve-getPointAtParam pl (setq pa (- pa 1)))) (setq lst (cons pt lst)))
)

(DEFUN remove-doubles (lst)
  (IF lst
    (CONS (CAR lst) (remove-doubles (VL-REMOVE (CAR lst) lst)))
  )
)

(defun c:test ()
  (vl-load-com)
  (setq maxgap 2.0)
  (setq fuzz 0.001)
  (prompt "\nSelect Polyline to be changed:")
  (setq pl1 (ssname (ssget "_:L" (list (cons 0 "*POLYLINE") (cons 70 1))) 0))
  (prompt "\nSelect Polyline to base from:")
  (setq pl2 (ssname (ssget "_:L" (list (cons 0 "*POLYLINE") (cons 70 1))) 0))
  (setq obj1 (vlax-ename->vla-object pl1))
  (setq obj2 (vlax-ename->vla-object pl2))
  (setq vertex1 (Poly-Pts obj1))
  (setq vertex2 (Poly-Pts obj2))
  (setq lst1 nil)
  (setq lst2 nil)
  (mapcar (function (lambda (xx)
      (if (> (apply 'min (mapcar (function (lambda (yy) (distance xx yy))) vertex2)) maxgap)
(setq lst1 (cons xx lst1))
      )
    )
  )
  vertex1
  )
  (mapcar (function (lambda (xx)
      (if (<= (apply 'min (mapcar (function (lambda (yy) (distance xx yy))) vertex1)) maxgap)
(setq lst2 (cons xx lst2))
      )
    )
  )
  vertex2
  )
  (setq lst2 (reverse (remove-doubles (reverse lst2))))
  (setq found nil)
  (setq finalv nil)
  (setq frstrun T)
  (foreach xx vertex1
    (if (member xx lst1)
      (progn (setq finalv (append finalv (list xx))))
      (progn (if frstrun
       (progn (setq frstrun nil)
      (if (> (distance xx (nth 0 lst2)) (distance xx (nth (- (length lst2) 1) lst2)))
(setq lst2 (reverse lst2))
      )
      (setq finalv (append finalv lst2))
       )
     )
      )
    )
  )
  (setq dd nil)
  (setq frstrun T)
  (setq eee (entget pl1))
  (setq GCList nil)
  (mapcar '(lambda (xx)
     (setq GCList (append GCList (list (cons 10 xx) (assoc 40 eee) (assoc 41 eee) (assoc 42 eee) (assoc 91 eee))))
   )
  finalv
  )
  (setq GCList (cons (cons 90 (length finalv)) GCList))
  (mapcar (function (lambda (yy)
      (if (or (equal (car yy) 10)
      (equal (car yy) 40)
      (equal (car yy) 41)
      (equal (car yy) 42)
      (equal (car yy) 90)
      (equal (car yy) 91)
  )
(progn (if frstrun
(progn (setq frstrun nil) (setq dd (append dd GCList)))
       )
)
(setq dd (append dd (list yy)))
      )
    )
  )
  (entget pl1)
  )
  (entmod dd)
  (entupd pl1)
  (princ)
)