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

0 Members and 1 Guest are viewing this topic.

hunterxyz

  • Guest
How do you simplify a LWPolyline vertex?
« on: November 08, 2007, 06:00:33 PM »
How likes the attached figure,
simplifies on "LWPOLYLINE" to duplicate the line segment angle the apex?

Requests fellow masters to be allowed to help to solve ~
to thank ~
« Last Edit: November 09, 2007, 10:30:19 AM by Daron »

Bob Wahr

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #1 on: November 08, 2007, 06:22:34 PM »
try OVERKILL

Cathy

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #2 on: November 08, 2007, 06:29:06 PM »
or try pedit;edit vertex;straighten

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #3 on: November 08, 2007, 07:38:46 PM »
Links removed as they did not address the requested lisp help.
« Last Edit: November 09, 2007, 12:07:19 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.

Jan ter Aij

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #4 on: November 09, 2007, 08:25:08 AM »
try OVERKILL

If You don't like the solution from Bob Wahr or CAB,
then try PEDIT with Edit vertex and optie Straighten,
or try after EXPLODE the command JOIN.
« Last Edit: November 09, 2007, 09:06:56 AM by Jan ter Aij »

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #5 on: November 09, 2007, 09:23:04 AM »
look here
http://www.theswamp.org/index.php?topic=2171.msg28102#msg28102
and here.
http://www.theswamp.org/index.php?topic=2024.msg26001#msg26001


Alan,

I think, though I may be wrong, the routines you pointed to don't answer the question in the sense the plines in the example file posted should not need any questions about distance or angle.

As I read it the OP simply wants to remove any vertex which is collinear with the preceding and following vertex.

That's not hard to do when the pline does not contain arcs. When it does, I'm thinking look at what gile posted recently regarding delete a vertex from a pline. Which as I recall, handles bulges correctly when a vertex is deleted.

Regards

daron

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #6 on: November 09, 2007, 10:30:43 AM »
Changed Title for clarity.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #7 on: November 09, 2007, 11:29:22 AM »
Joe,
Sorry I was in a hurry & did not find an appropriate routine.

Here is a quickie.
Code: [Select]
;;;=======================[ PSimple.lsp ]=======================
;;; Author: Charles Alan Butler
;;; Version:  1.1 Nov. 09, 2007
;;; Purpose: To remove un needed vertex from a pline
;;;=============================================================

;;  Note, very little testing has been done at this time
(defun c:PSimple (/ doc ent elst vlst idx dir keep result hlst len
                  group_on)
  (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)
  ;;  Result  ((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)
  )

 
  (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
          ((not (zerop (cdr(cadddr (nth idx vlst))))) ; keep arcs
           (setq result (cons (nth idx vlst) result))
          )
          ((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)

<edit: revised code>
« Last Edit: November 09, 2007, 12:05:30 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.

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: How do you simplify a LWPolyline vertex?
« Reply #8 on: November 09, 2007, 12:28:34 PM »
Hi,

Here's one quite dirty but which works with polyarcs too.

Excuse for non-translated comments.

edit: corrected a bug according to Joe's remark.

edit2: works now with widthes

edit3: EndUndoMark corrected

Code: [Select]
;;; VEC1 Returns the single unit vector from p1 to p2

(defun vec1 (p1 p2 / d)
  (if (not (zerop (setq d (distance p1 p2))))
    (mapcar '(lambda (x1 x2) (/ (- x2 x1) d)) p1 p2)
  )
)

;; BETWEENP Evaluates if pt is between p1 et p2

(defun betweenp (p1 p2 pt)
  (or (equal p1 pt 1e-9)
      (equal p2 pt 1e-9)
      (equal (vec1 p1 pt) (vec1 pt p2) 1e-9)
  )
)

;;; 2d-coord->pt-lst Convert a flat 20 coordinates list into a 2d points list
;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0) (3.0 4.0))

(defun 2d-coord->pt-lst (lst)
  (if lst
    (cons (list (car lst) (cadr lst))
  (2d-coord->pt-lst (cddr lst))
    )
  )
)

;; BulgeData Returns a 'bulge datas list' (angle radius center)
(defun BulgeData (bu p1 p2 / ang rad)
  (setq ang (* 2 (atan bu))
rad (/ (distance p1 p2)
       (* 2 (sin ang))
    )
cen (polar p1
   (+ (angle p1 p2) (- (/ pi 2) ang))
   rad
    )
  )
  (list (* ang 2.0) rad cen)
)

;; TAN Returns the angle tangent

(defun tan (ang)
  (/ (sin ang) (cos ang))
)


;; Deletes aligned vertices of a pline (vla-object)

(defun CleanPline (pl     /      regular-width     closed old-p
   n     sw      ew       old-b    old-w new-p
   new-b    new-w    b1       b2
  )

  (defun regular-width (p1 p2 p3 w1 w2 / delta norm)
    (setq delta (- (cadr w2) (car w1))
  norm (vlax-get pl 'Normal)
    )
    (and (= (cadr w1) (car w2))
(equal (/ (- (vlax-curve-getDistAtPoint pl (trans p2 norm 0))
      (vlax-curve-getDistAtPoint pl (trans p1 norm 0))
   )
   (- (vlax-curve-getDistAtPoint pl (trans p3 norm 0))
      (vlax-curve-getDistAtPoint pl (trans p1 norm 0))
   )
)
(/ (- (cadr w1) (- (cadr w2) delta)) delta)
0.01
)
    )
  )

  (setq closed (vla-get-Closed pl)
old-p  (2d-coord->pt-lst (vlax-get pl 'Coordinates))
  )
  (repeat (setq n (if (= closed :vlax-true)
    (1+ (length old-p))
    (length old-p)
  )
  )
    (vla-getWidth pl (setq n (1- n)) 'sw 'ew)
    (setq old-b (cons (vla-getBulge pl n) old-b)
  old-w (cons (list sw ew) old-w)
    )
  )
  (if (= closed :vlax-true)
    (setq old-p (append old-p (list (car old-p))))
  )
  (while (cddr old-p)
    (if (or (= (caar old-w) (cadar old-w) (caadr old-w) (cadadr old-w))
    (regular-width
      (car old-p)
      (cadr old-p)
      (caddr old-p)
      (car old-w)
      (cadr old-w)
    )
)
      (if (and (zerop (car old-b))
       (zerop (cadr old-b))
  )
(if (betweenp (car old-p) (caddr old-p) (cadr old-p))
  (setq old-p (cons (car old-p) (cddr old-p))
old-b (cons (car old-b) (cddr old-b))
old-w (cons (list (caar old-w) (cadadr old-w)) (cddr old-w))
  )
  (setq new-p (cons (car old-p) new-p)
new-b (cons (car old-b) new-b)
new-w (cons (car old-w) new-w)
old-p (cdr old-p)
old-b (cdr old-b)
old-w (cdr old-w)
  )
)
(if
  (and
    (/= 0.0 (car old-b))
    (/= 0.0 (cadr old-b))
    (equal (caddr
     (setq b1 (BulgeData (car old-b) (car old-p) (cadr old-p)))
   )
   (caddr
     (setq b2 (BulgeData (cadr old-b) (cadr old-p) (caddr old-p)))
   )
   1e-4
    )
  )
   (setq old-p (cons (car old-p) (cddr old-p))
old-b (cons (tan (/ (+ (car b1) (car b2)) 4.0)) (cddr old-b))
old-w (cons (list (caar old-w) (cadadr old-w)) (cddr old-w))
   )
   (setq new-p (cons (car old-p) new-p)
new-b (cons (car old-b) new-b)
new-w (cons (car old-w) new-w)
old-p (cdr old-p)
old-b (cdr old-b)
old-w (cdr old-w)
   )
)
      )
      (setq new-p (cons (car old-p) new-p)
    new-b (cons (car old-b) new-b)
    new-w (cons (car old-w) new-w)
    old-p (cdr old-p)
    old-b (cdr old-b)
    old-w (cdr old-w)
      )
    )
  )
  (if (= (vla-get-closed pl) :vlax-true)
    (setq new-p (reverse (append (cdr (reverse old-p)) new-p)))
    (setq new-p (append (reverse new-p) old-p))
  )
  (setq new-b (append (reverse new-b) old-b)
new-w (append (reverse new-w) old-w)
  )
  (vlax-put pl 'Coordinates (apply 'append new-p))
  (setq n (1- n))
  (repeat (length new-b)
    (vla-setBulge pl (setq n (1+ n)) (nth n new-b))
    (vla-setWidth pl n (car (nth n new-w)) (cadr (nth n new-w)))
  )
)

Calling function

Code: [Select]
(defun c:cpl (/ pl)
  (vl-load-com)
  (and
    (setq pl (car (entsel)))
    (setq pl (vlax-ename->vla-object pl))
    (= (vla-get-ObjectName pl) "AcDbPolyline")
    (or (vla-StartUndoMark
  (vla-get-ActiveDocument (vlax-get-acad-object))
)
T
    )
    (vl-catch-all-apply 'CleanPline (list pl))
    (vla-StartUndoMark
      (vla-get-ActiveDocument (vlax-get-acad-object))
    )
  )
  (princ)
)
« Last Edit: November 12, 2007, 09:58:04 AM by gile »
Speaking English as a French Frog

hunterxyz

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #9 on: November 11, 2007, 02:25:12 AM »
THANK CAB
PSimple.lsp Normal execution

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #10 on: November 11, 2007, 09:56:48 AM »
Hi gile,

Check your code with the example file posted. It seems OK with the plines which don't contain arcs. But when arcs are included, I'm getting divide by zero errors.

I'm reworking similar code I started some time ago. I've not worked out all the kinks yet, but I think I'm fairly close.

Regards

gile

  • Gator
  • Posts: 2507
  • Marseille, France
Re: How do you simplify a LWPolyline vertex?
« Reply #11 on: November 11, 2007, 11:28:22 AM »
Thanks Joe,

I forgot to check a if the second bulge was 0.0 before comparing two following ones.
I edit the code.

« Last Edit: November 11, 2007, 11:52:16 AM by gile »
Speaking English as a French Frog

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #12 on: November 11, 2007, 07:16:50 PM »
Gile, I got an odd result.
Quote
Command: test
Select object: ; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception
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.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: How do you simplify a LWPolyline vertex?
« Reply #13 on: November 11, 2007, 07:18:59 PM »
This is the result with my routine.
Also note that the width data is maintained at each vertex, but no interpolation
is attempted on my part.
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 #14 on: November 11, 2007, 07:54:13 PM »
Gile, I got an odd result.
Quote
Command: test
Select object: ; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception

The unwind error with a lwpline usually means an attempt to add or remove more than one vertex at a time. At least in my experience.