Author Topic: How do you simplify a LWPolyline vertex?  (Read 47691 times)

0 Members and 1 Guest are viewing this topic.

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #30 on: November 13, 2007, 09:08:13 AM »
Michael,

Thanks for confirmation.

Regards

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: How do you simplify a LWPolyline vertex?
« Reply #31 on: November 13, 2007, 09:21:31 AM »
Hi,

Thanks Joe for your explainations, we had this problem before, but we were unable to fix it.
By my side, I'd rather use entmod than delete or add points one by one.

I revised the code (link to reply 23) , it has now two commands for two (quite) different behavior according to how a vertex is aligned.

Ppl: command removes all aligned (or on the same arc) vertex.
Cpl: keeps the vertex which are 'comming back' on the pline traject.

Somme pictures should tell more than my poor English.



 
« Last Edit: November 13, 2007, 10:39:41 AM by CAB »
Speaking English as a French Frog

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #32 on: November 13, 2007, 10:20:52 AM »
gile,

You're more than welcome to whatever insights I *might* have provided. But I don't think the implications mean you should back off and use entmode rather than vlisp methods.

I will ry to post my code soon which demonstartes why I don't think it's needed.

Of course there's nothing wrong with entmod... other than it doesn't fit vlisp drift.

Regards

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #33 on: November 13, 2007, 07:25:38 PM »
Added support for simplifying arc in the plines.
Code: [Select]
;;;=======================[ PSimple.lsp ]=======================
;;; Author: Charles Alan Butler
;;; Version:  1.2 Nov. 13, 2007
;;; Purpose: To remove unnecessary vertex from a pline
;;; Supports arcs and varying widths within the LWpolylines
;;;=============================================================

(defun c:PSimple (/ aa cpt dir doc elst ent hlst idx keep len newb result
                  v1 v2 v3 vlst x group_on dxf BulgeCenter)
  (vl-load-com)

  ;; CAB 11/03/07
  ;;  group on the elements of a flat list
  ;;  (group_on '(A B C D E F G) 3) --> ((A B C) (D E F) (G nil nil)...)
  (defun group_on (inplst gp# / outlst idx subLst)
    (while inplst
      (setq idx -1 subLst nil)
      (while (< (setq idx (1+ idx)) gp#)
        (setq subLst (cons (nth idx inplst) sublst))
      )
      (setq outlst (cons (reverse sublst) outlst))
      (repeat gp# (setq inplst (cdr inplst)))
    )
    (reverse outlst)
  )

  (defun dxf (key lst)(cdr(assoc key lst)))

  (defun BulgeCenter (bulge p1 p2 / delta chord radius center)
     (setq delta(*(atan bulge)4)
           chord(distance p1 p2)
           radius(/ chord(sin(/ delta 2))2)
           center(polar p1(+ (angle p1 p2)(/(- pi delta)2))radius)
     )
  )

 
  ;;  ========  S T A R T   H E R E  ===========
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vla-StartUndoMark doc)
  (setq ent (car (entsel "\n Select polyline to remove extra vertex: ")))
  (if (and ent
           (setq elst (entget ent))
           (equal (assoc 0 elst) '(0 . "LWPOLYLINE"))
      )
    (progn
      (setq idx 0)
      (repeat (fix (vlax-curve-getendparam ent))
        (cond
          ((null keep)
           (setq keep '(1)
                 dir  (angle '(0 0) (vlax-curve-getFirstDeriv ent 0.0))
           ))
          ((or (null(vlax-curve-getFirstDeriv ent idx))
               (equal dir (setq dir (angle '(0 0)
                             (vlax-curve-getFirstDeriv ent idx))) 0.000001))
           (setq keep (cons 0 keep))
          )
          ((setq keep (cons 1 keep)))
        )
        (setq idx (1+ idx))
      )
      (setq vlst (vl-remove-if-not
                   '(lambda (x) (vl-position (car x) '(40 41 42 10))) elst))
      (setq vlst (group_on vlst 4))
      (setq idx -1
            len (1- (length vlst))
            keep (reverse (cons 1 keep))
      )
      (while (<= (setq idx (1+ idx)) len)
        (cond
          ;;  catch 2 arcs with same center pt
          ((and (< idx len)
                (not (zerop (cdr(cadddr (setq v1 (nth idx vlst))))))
                (setq v3 (nth (+ idx 2) vlst))
                (not (zerop (cdr(cadddr (setq v2 (nth (1+ idx) vlst))))))
                (equal (setq cpt (BulgeCenter (dxf 42 v1)(dxf 10 v1)(dxf 10 v2)))
                       (BulgeCenter (dxf 42 v2)(dxf 10 v2)(dxf 10 v3))
                       1e-4)
           )
           ;;  combine the arcs
           (setq aa (+ (* 4 (atan (abs (dxf 42 v1))))
                       (* 4 (atan (abs (dxf 42 v2)))))
                  newb (tan (/ aa 4.0)))
           (if (minusp (dxf 42 v1))
             (setq newb (- (abs newb)))
             (setq newb (abs newb))
           )
           (setq vlst (subst (list (car v1)   ; point
                                   (cadr v1)  ; Start Width
                                   (caddr v2) ; End Width
                                   (cons 42 newb) ; Bulge
                                   )
                             (nth (1+ idx) vlst) vlst))
          )
          ((or (not (zerop (cdr(cadddr (nth idx vlst))))) ; keep arcs
               (not (zerop (nth idx keep))))
            (setq result (cons (nth idx vlst) result))
          )
        )
      )

      (setq hlst (vl-remove-if
                   '(lambda (x) (vl-position (car x) '(40 41 42 10))) elst))
      (mapcar '(lambda(x) (setq hlst (append hlst x))) (reverse result))
      (setq hlst (subst (cons 90 (length result)) (assoc 90 hlst) hlst))
      (entmod hlst)
    )
  )
  (vla-EndUndoMark doc)

  (princ)
)
(prompt "\nPline Simplify loaded, PSimple to run.")
(princ)
« Last Edit: November 14, 2007, 08:49:36 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #34 on: November 14, 2007, 05:38:18 AM »
Alan,

Given the original example file, try adding a vertex in the last segment of either of the closed plines. The code will miss the added vertex. I mention it because I had trouble with that too.

My routine also uses vlax-curve-getFirstDeriv.

Later... looks like gile's routine also misses the added vertex.

Later... on second thought, I may be wrong about this due to the method I used to add a vertex. It made the new vertex the first vertex.
« Last Edit: November 14, 2007, 07:33:11 AM by Joe Burke »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #35 on: November 14, 2007, 08:53:53 AM »
Joe,
On a Closed pline the start point is not removed even though it is not needed.
I'll look into that, thanks.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #36 on: November 14, 2007, 01:44:44 PM »
Joe,
On a Closed pline the start point is not removed even though it is not needed.
I'll look into that, thanks.


Alan,

Yes, that's also an issue to consider.

It may go deeper than what you'd expect at first glance. If I draw a closed pline like your example, where the first point is inline with the second point and the point preceding the first point, and then I set the pline to not closed... guess what. The first point is not the first point anymore. It shifted to the point before the actual first point.

Seems to me this means it's problematic at best trying to determine where the first vertex really is. Which in turn leads me to think it may be easier to use some ugly kludge which explodes the pline, heals lines which can be healed, and then puts the pline back together using join.

What a horrible thought...  ;-)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #37 on: November 14, 2007, 01:56:38 PM »
Maybe short sighted on my part but if it is a closed polyline what does it matter which is the first point?
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #38 on: November 16, 2007, 09:39:13 AM »
Alan,

Agreed, it probably doesn't matter where the start point is within a closed pline in terms of how the user would interface with the object.

What I was trying to say in my last post, albeit poorly, was it may matter how you might attempt to deal the issue codewise per your last example. If typically the start point cannot be a collinear point, then your code should work without alteration. If otherwise, I think the code would have to look at the point before the first point and the point after in order to determine whether the first point should be removed since the firstderiv method doesn't look fowards and backwards.

Stepping back, I'm often reminded of Doug Broad's argument regarding the law of diminshing returns as it applies to code. Your code works well. Perfect isn't required, only desireable.  ;-)

BTW, I've worked on a facilities managment project where the integrity of existing plines was paramount because they are linked to a database. So explode, modify lines, and join would not work since the original pline handle would be lost.

Regards

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #39 on: November 17, 2007, 10:45:18 AM »
Well said Joe, but I love a challenge.

This version will remove the first vertex if closed and first & last vertex are collinear or
arcs have the same center.
Code: [Select]
;;;=======================[ PSimple.lsp ]=======================
;;; Author: Charles Alan Butler
;;; Version:  1.3 Nov. 17, 2007
;;; Purpose: To remove unnecessary vertex from a pline
;;; Supports arcs and varying widths
;;;=============================================================
;;  This version will remove the first vertex if closed and first & last vertex are
;;  collinear or arcs have the same center.
(defun c:PSimple (/      aa     cpt    dir    doc    elst   ent    hlst
                  idx    keep   len    newb   result vlst   x      closed
                  d10    d40    d41    d42    hlst   p1     p2     p3
                  plast remove  BulgeCenter   RemoveNlst
                  )
  (vl-load-com)

  (defun tan (a) (/ (sin a) (cos a)))

  (defun replace (lst i itm)
    (setq i (1+ i))
    (mapcar '(lambda (x) (if (zerop (setq i (1- i))) itm x)) lst)
  )

 
  ;;  CAB 11.16.07
  ;;  Remove based on pointer list
  (defun RemoveNlst (nlst lst)
    (setq i -1)
    (vl-remove-if  '(lambda (x) (not (null (vl-position (setq i (1+ i)) nlst)))) lst)
  )
 
  (defun BulgeCenter (bulge p1 p2 / delta chord radius center)
    (setq delta  (* (atan bulge) 4)
          chord  (distance p1 p2)
          radius (/ chord (sin (/ delta 2)) 2)
          center (polar p1 (+ (angle p1 p2) (/ (- pi delta) 2)) radius)
    )
  )


  ;;  ========  S T A R T   H E R E  ===========
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (setq ent (car (entsel "\n Select polyline to remove extra vertex: ")))
  (if (and ent
           (setq elst (entget ent))
           (equal (assoc 0 elst) '(0 . "LWPOLYLINE"))
      )
    (progn
      ;;=====================================================

      (setq d10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst)))
      (if (> (length d10) 2)
        (progn
          (setq d40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) elst)))
          (setq d41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) elst)))
          (setq d42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) elst)))
          (setq plast (1- (length d10)))
          (if (setq closed (vlax-curve-isclosed ent))
            (setq p1 plast  p2 0  p3 1 )
            (setq p1 0  p2 1  p3 2)
          )
          (setq idx -1)
          (while (< (setq idx (1+ idx)) (if closed (1+ plast) plast))
            (cond
              ((and (equal (angle (nth p1 d10) (nth p2 d10))
                           (angle (nth p2 d10) (nth p3 d10)) 1e-6)
                    (zerop (nth p2 d42))
                    (or (= p1 plast)
                        (zerop (nth p1 d42)))
               )
               (setq remove (cons p2 remove))
               (setq p2 (1+ p2)
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
              ((and (not (zerop (nth p2 d42)))
                    (or closed (/= p1 plast))
                    (not (zerop (nth p1 d42))) ; got two arcs
                    (equal
                      (setq cpt (BulgeCenter (nth p1 d42) (nth p1 d10) (nth p2 d10)))
                      (BulgeCenter (nth p2 d42) (nth p2 d10) (nth p3 d10))
                      1e-4)
               )
               ;;  combine the arcs
               (setq aa   (+ (* 4 (atan (abs (nth p1 d42))))(* 4 (atan (abs (nth p2 d42)))))
                     newb (tan (/ aa 4.0))
               )
               (if (minusp (nth p1 d42))
                 (setq newb (- (abs newb)))
                 (setq newb (abs newb))
               )
               (setq remove (cons p2 remove))
               (setq d42 (replace d42 p1 newb))
               (setq p2 (1+ p2)
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
              (t
               (setq p1 p2
                     p2 (1+ p2)
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
            )
          )
          (if remove
            (progn
              (setq d10 (RemoveNlst remove d10)
                    d40 (RemoveNlst remove d40)
                    d41 (RemoveNlst remove d41)
                    d42 (RemoveNlst remove d42)
              )
              (setq result (mapcar '(lambda(w x y z) (list(cons 10 w)
                                        (cons 40 x)(cons 41 y)
                                        (cons 42 z))) d10 d40 d41 d42)
              )
              (setq hlst (vl-remove-if
                           '(lambda (x) (vl-position (car x) '(40 41 42 10))) elst)
              )
              (mapcar '(lambda (x) (setq hlst (append hlst x))) result)
              (setq hlst (subst (cons 90 (length result)) (assoc 90 hlst) hlst))
              (entmod hlst)
            )
            (prompt "\nNothing to remove.")
          )
        )
        (prompt "\nNothing to do - Only two vertex.")
      )
    )
    (prompt "\nError - Not a LWpolyline.")
  )
  (vla-endundomark doc)
  (princ)
)
(prompt "\nPline Simplify loaded, PSimple to run.")
(princ)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #40 on: November 18, 2007, 11:31:11 AM »
Hi Alan,

I haven't had a chance to test your latest code yet, but I will over the weekend.

I mentioned some messages back I was working on my own version. I put it on the back burner, waiting to see what you gile come up with. Both of you were ahead of me from the begining. So now maybe I'm just a beta tester.

Regards

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #41 on: November 18, 2007, 01:31:06 PM »
Thanks Joe,
Let us know if you see a better way, or if you find any insects. 8-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #42 on: November 20, 2007, 07:43:46 AM »
Thanks Joe,
Let us know if you see a better way, or if you find any insects. 8-)

Hi Alan,

The new code solves the issue discussed recently for the most part.

Attached is an example file which shows it's not quite perfect yet. I'm almost hesitant to post it lest you think I'm nit-picking.

Regards

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #43 on: November 20, 2007, 08:34:42 PM »
I'm glad you did post & thanks for the testing.
It always helps to have a second set of eyes.
Give this a spin when you get time.
Code: [Select]
;;;=======================[ PSimple.lsp ]=======================
;;; Author: Charles Alan Butler
;;; Version:  1.5 Nov. 20, 2007
;;; Purpose: To remove unnecessary vertex from a pline
;;; Supports arcs and varying widths
;;;=============================================================
;; This version will remove the first vertex if it is colinear
;; and first & last arcs that have the same center
(defun c:PSimple (/      aa     cpt    dir    doc    elst   ent    hlst
                  idx    keep   len    newb   result vlst   x      closed
                  d10    d40    d41    d42    hlst   p1     p2     p3
                  plast remove  BulgeCenter   RemoveNlst
                  )
  (vl-load-com)

  (defun tan (a) (/ (sin a) (cos a)))

  (defun replace (lst i itm)
    (setq i (1+ i))
    (mapcar '(lambda (x) (if (zerop (setq i (1- i))) itm x)) lst)
  )

 
  ;;  CAB 11.16.07
  ;;  Remove based on pointer list
  (defun RemoveNlst (nlst lst)
    (setq i -1)
    (vl-remove-if  '(lambda (x) (not (null (vl-position (setq i (1+ i)) nlst)))) lst)
  )
 
  (defun BulgeCenter (bulge p1 p2 / delta chord radius center)
    (setq delta  (* (atan bulge) 4)
          chord  (distance p1 p2)
          radius (/ chord (sin (/ delta 2)) 2)
          center (polar p1 (+ (angle p1 p2) (/ (- pi delta) 2)) radius)
    )
  )


  ;;  ========  S T A R T   H E R E  ===========
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (setq ent (car (entsel "\n Select polyline to remove extra vertex: ")))
  (if (and ent
           (setq elst (entget ent))
           (equal (assoc 0 elst) '(0 . "LWPOLYLINE"))
      )
    (progn
      ;;=====================================================

      (setq d10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst)))
      (if (> (length d10) 2)
        (progn
          (setq d40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) elst))
          (setq d41 (vl-remove-if-not '(lambda (x) (= (car x) 41)) elst))
          (setq d42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) elst)))
          (setq plast (1- (length d10)))
          (setq p1 0  p2 1  p3 2)
          (setq closed (vlax-curve-isclosed ent))
          (setq idx -1)
          (while (<= (setq idx (1+ idx)) (if closed (+ plast 2) (- plast 2)))
            (cond
              ((and (or (equal (angle (nth p1 d10) (nth p2 d10))
                               (angle (nth p2 d10) (nth p3 d10)) 1e-6)
                        (equal (nth p1 d10) (nth p2 d10))
                        (equal (nth p2 d10) (nth p3 d10)))
                    (zerop (nth p2 d42))
                    (or (= p1 plast)
                        (zerop (nth p1 d42)))
               )
               (setq remove (cons p2 remove))
               (setq p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
              ((and (not (zerop (nth p2 d42)))
                    (or closed (/= p1 plast))
                    (not (zerop (nth p1 d42))) ; got two arcs
                    (equal
                      (setq cpt (BulgeCenter (nth p1 d42) (nth p1 d10) (nth p2 d10)))
                      (BulgeCenter (nth p2 d42) (nth p2 d10) (nth p3 d10))
                      1e-4)
               )
               ;;  combine the arcs
               (setq aa   (+ (* 4 (atan (abs (nth p1 d42))))(* 4 (atan (abs (nth p2 d42)))))
                     newb (tan (/ aa 4.0))
               )
               (if (minusp (nth p1 d42))
                 (setq newb (- (abs newb)))
                 (setq newb (abs newb))
               )
               (setq remove (cons p2 remove))
               (setq d42 (replace d42 p1 newb))
               (setq p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
              (t
               (setq p1 p2
                     p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
            )
          )
          (if remove
            (progn
              (setq d10 (RemoveNlst remove d10)
                    d40 (RemoveNlst remove d40)
                    d41 (RemoveNlst remove d41)
                    d42 (RemoveNlst remove d42)
              )
              (setq result (mapcar '(lambda(w x y z) (list(cons 10 w)
                                        x  y
                                        (cons 42 z))) d10 d40 d41 d42)
              )
              (setq hlst (vl-remove-if
                           '(lambda (x) (vl-position (car x) '(40 41 42 10))) elst)
              )
              (mapcar '(lambda (x) (setq hlst (append hlst x))) result)
              (setq hlst (subst (cons 90 (length result)) (assoc 90 hlst) hlst))
              (entmod hlst)
            )
            (prompt "\nNothing to remove.")
          )
        )
        (prompt "\nNothing to do - Only two vertex.")
      )
    )
    (prompt "\nError - Not a LWpolyline.")
  )
  (vla-endundomark doc)
  (princ)
)
(prompt "\nPline Simplify loaded, PSimple to run.")
(princ)

PS Sorry for the late reply. This was one of those rare days that I spent the entire day out of the office. 8-)
« Last Edit: November 20, 2007, 08:44:26 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Kerry

  • Mesozoic relic
  • Seagull
  • Posts: 11654
  • class keyThumper<T>:ILazy<T>
Re: How do you simplify a LWPolyline vertex?
« Reply #44 on: November 20, 2007, 08:52:39 PM »

Alan,

I'm compelled to publically applaud your untiring effort and unstinting generosity with the code you post and for your tenacity regarding assisting solving members problems here.

Regards,
Kerry.
kdub, kdub_nz in other timelines.
Perfection is not optional.
Everything will work just as you expect it to, unless your expectations are incorrect.
Discipline: None at all.