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

0 Members and 1 Guest are viewing this topic.

gile

  • Water Moccasin
  • Posts: 2235
  • Marseille, France
Re: How do you simplify a LWPolyline vertex?
« Reply #15 on: November 12, 2007, 04:42:59 AM »
Alan,

I can't reproduce the error you got.

I revised my code so that it has a coherent behavior with widthes : the aligned vertex is removed only if width is constant or 'regular'.



Speaking English as a French Frog

CAB

  • Global Moderator
  • Seagull
  • Posts: 10378
Re: How do you simplify a LWPolyline vertex?
« Reply #16 on: November 12, 2007, 08:47:18 AM »
Gile,
Use the attached drawing for your test.
I tested in ACAD2000, If it test ok for you perhaps it's a version problem.

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

  • Water Moccasin
  • Posts: 2235
  • Marseille, France
Re: How do you simplify a LWPolyline vertex?
« Reply #17 on: November 12, 2007, 09:21:52 AM »
Alan,

I've got no problem whith your file, may be a version problem.

Can you see which expression make the routine fail ?
Speaking English as a French Frog

CAB

  • Global Moderator
  • Seagull
  • Posts: 10378
Re: How do you simplify a LWPolyline vertex?
« Reply #18 on: November 12, 2007, 09:37:47 AM »
Same problem in ACAD2004:
Quote
Command: cpl

Select object: ; error: Exception occurred: 0xC0000005 (Access Violation)
; warning: unwind skipped on unknown exception
With the catchall removed from cpl the VLIDE is still not triggered in eather version of ACAD just the warning message.
See results below.
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

  • Water Moccasin
  • Posts: 2235
  • Marseille, France
Re: How do you simplify a LWPolyline vertex?
« Reply #19 on: November 12, 2007, 10:02:52 AM »
It works fine in acad2007.
Regarding what was saying Joe, perhaps the error is due to the (vlax-put pl 'Coordinates (apply 'append new-p)) expression near the ehd of 'CleanPline' routine.

Does it works if you replace it by :

Code: [Select]
(vla-delete pl)
  (setq pl
(vlax-invoke
   (vla-get-ModelSpace
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
   'addLightWeightPolyline
   (apply 'append new-p)
)
  )

PS : I revised the code to close the undo group in Cpl.
« Last Edit: November 12, 2007, 10:03:56 AM by gile »
Speaking English as a French Frog

CAB

  • Global Moderator
  • Seagull
  • Posts: 10378
Re: How do you simplify a LWPolyline vertex?
« Reply #20 on: November 12, 2007, 10:11:10 AM »
The new code also produces the error, but the patch you posted produces good results & no warning.
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

  • Water Moccasin
  • Posts: 2235
  • Marseille, France
Re: How do you simplify a LWPolyline vertex?
« Reply #21 on: November 12, 2007, 10:28:10 AM »
OK, so the (vlax-put pl 'Coordinates ...) is not supported.

But the patch isn't a so good solution, cause it creates a new entity and the deleted pline could have been linked by its handle or objectID.

I'm trying to make an 'entmod' release...
Speaking English as a French Frog

MP

  • Seagull
  • Posts: 17530
Re: How do you simplify a LWPolyline vertex?
« Reply #22 on: November 12, 2007, 11:06:49 AM »
OK, so the (vlax-put pl 'Coordinates ...) is not supported.

Nope:

PROPERTIES

    ("Application" #<VLA-OBJECT IAcadApplication 00d73d3c> VISIBLE READONLY)
    ("Area" 8976.87 VISIBLE READONLY)
    ("Closed" 0 VISIBLE READONLY)
    ("Color" 256 HIDDEN READONLY)
    ("ConstantWidth" 0.0 VISIBLE READONLY)
    ("Coordinate" "<Error: Invalid number of parameters>" VISIBLE READONLY)
    ("Coordinates" (70.326 22.6916 117.289 22.6916 ...) VISIBLE READONLY)
    ("Database" #<VLA-OBJECT IAcadDatabase 0bc4ffd4> HIDDEN READONLY)
    ("Document" #<VLA-OBJECT IAcadDocument 01c35fc8> VISIBLE READONLY)
    ("Elevation" 0.0 VISIBLE READONLY)
    ("EntityName" "AcDbPolyline" HIDDEN READONLY)
    ("EntityType" 24 HIDDEN READONLY)
    ("Handle" "28D6" VISIBLE READONLY)
    ("HasExtensionDictionary" 0 VISIBLE READONLY)
    ("Hyperlinks" #<VLA-OBJECT IAcadHyperlinks 0bf9e2e4> VISIBLE READONLY)
    ("Layer" "0" VISIBLE READONLY)
    ("Length" 254.984 VISIBLE READONLY)
    ("Linetype" "ByLayer" VISIBLE READONLY)
    ("LinetypeGeneration" 0 VISIBLE READONLY)
    ("LinetypeScale" 1.0 VISIBLE READONLY)
    ("Lineweight" -1 VISIBLE READONLY)
    ("Material" "ByLayer" VISIBLE READONLY)
    ("Normal" (0.0 0.0 1.0) VISIBLE READONLY)
    ("ObjectID" 2126299568 VISIBLE READONLY)
    ("ObjectName" "AcDbPolyline" VISIBLE READONLY)
    ("OwnerID" 2130317008 VISIBLE READONLY)
    ("PlotStyleName" "ByLayer" VISIBLE READONLY)
    ("Thickness" 0.0 VISIBLE READONLY)
    ("TrueColor" #<VLA-OBJECT IAcadAcCmColor 0be616a8> VISIBLE READONLY)
    ("Visible" -1 VISIBLE READONLY)(NAME ARGUMENTS VISIBILITY)
   
METHODS   
   
    ("AddRef" nil VISIBLE)
    ("AddVertex" (("Index" INT) ("vertex" variant)) VISIBLE)
    ("ArrayPolar" (("NumberOfObjects" INT) ("AngleToFill" REAL) ("CenterPoint" variant)) VISIBLE)
    ("ArrayRectangular" (("NumberOfRows" INT) ("NumberOfColumns" INT) ("NumberOfLevels" INT) ("DistBetweenRows" REAL) ("DistBetweenCols" REAL) ("DistBetweenLevels" REAL)) VISIBLE)
    ("Copy" nil VISIBLE)
    ("Delete" nil VISIBLE)
    ("Erase" nil HIDDEN)
    ("Explode" nil VISIBLE)
    ("GetBoundingBox" (("MinPoint" variant) ("MaxPoint" variant)) VISIBLE)
    ("GetBulge" (("Index" INT)) VISIBLE)
    ("GetExtensionDictionary" nil VISIBLE)
    ("GetIDsOfNames" (("riid" EMPTY) ("rgszNames" I1) ("cNames" UINT) ("lcid" UI4) ("rgdispid" I4)) VISIBLE)
    ("GetTypeInfo" (("itinfo" UINT) ("lcid" UI4) ("pptinfo" VOID)) VISIBLE)
    ("GetTypeInfoCount" (("pctinfo" UINT)) VISIBLE)
    ("GetWidth" (("Index" INT) ("StartWidth" REAL) ("EndWidth" REAL)) VISIBLE)
    ("GetXData" (("AppName" STR) ("XDataType" variant) ("XDataValue" variant)) VISIBLE)
    ("Highlight" (("HighlightFlag" BOOL)) VISIBLE)
    ("IntersectWith" (("IntersectObject" DISPATCH) ("option" EMPTY)) VISIBLE)
    ("Invoke" (("dispidMember" I4) ("riid" EMPTY) ("lcid" UI4) ("wFlags" UI2) ("pdispparams" EMPTY) ("pvarResult" variant) ("pexcepinfo" EMPTY) ("puArgErr" UINT)) VISIBLE)
    ("Mirror" (("Point1" variant) ("Point2" variant)) VISIBLE)
    ("Mirror3D" (("Point1" variant) ("Point2" variant) ("point3" variant)) VISIBLE)
    ("Move" (("FromPoint" variant) ("ToPoint" variant)) VISIBLE)
    ("Offset" (("Distance" REAL)) VISIBLE)
    ("QueryInterface" (("riid" EMPTY) ("ppvObj" VOID)) VISIBLE)
    ("Release" nil VISIBLE)
    ("Rotate" (("BasePoint" variant) ("RotationAngle" REAL)) VISIBLE)
    ("Rotate3D" (("Point1" variant) ("Point2" variant) ("RotationAngle" REAL)) VISIBLE)
    ("ScaleEntity" (("BasePoint" variant) ("ScaleFactor" REAL)) VISIBLE)
    ("SetBulge" (("Index" INT) ("bulge" REAL)) VISIBLE)
    ("SetWidth" (("Index" INT) ("StartWidth" REAL) ("EndWidth" REAL)) VISIBLE)
    ("SetXData" (("XDataType" variant) ("XDataValue" variant)) VISIBLE)
    ("TransformBy" (("TransformationMatrix" variant)) VISIBLE)
    ("Update" nil VISIBLE)




Sorry, couldn't resist. :)

There's also (vlax-property-available-p lwPolyLineObject 'coordinates t), the t argument checks if the property can be modified.
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

gile

  • Water Moccasin
  • Posts: 2235
  • Marseille, France
Re: How do you simplify a LWPolyline vertex?
« Reply #23 on: November 12, 2007, 11:39:28 AM »
MP

I should have said "not supported with A2000 and A2004." because it works fine with A2007, I use it a lot !
(vlax-property-available-p lwPolyLineObject 'coordinates t) returns T, as I understood Joe said the error got by Alan is due to adding or removing too much vertex at the same time.

Anyway, here's a new version using entmod rather than (vlax-put pl 'coordinates ...), perhaps it works on 'old' versions ?


EDIT: revised code, 2 commands (see downer reply 31)
Code: [Select]
;; CPL Calling Function

(defun c:cpl (/ ss n)
  (vl-load-com)
  (princ
    "\nSelect plines or <All>: "
  )
  (or (setq ss (ssget '((0 . "LWPOLYLINE"))))
      (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  )
  (if ss
    (progn
      (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq n -1)
      (while (setq pl (ssname ss (setq n (1+ n))))
(CleanPline pl nil)
      )
      (princ (strcat "\n\t" (itoa n) " treated pline(s)."))
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (princ "\nNone pline selected.")
  )
  (princ)
)

;; PPL Calling Function

(defun c:ppl (/ ss n)
  (vl-load-com)
  (princ
    "\nSelect plines or <All>: "
  )
  (or (setq ss (ssget '((0 . "LWPOLYLINE"))))
      (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
  )
  (if ss
    (progn
      (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq n -1)
      (while (setq pl (ssname ss (setq n (1+ n))))
(CleanPline pl T)
      )
      (princ (strcat "\n\t" (itoa n) " treated pline(s)."))
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (princ "\nNone pline selected.")
  )
  (princ)
)

;; CleanPline (gile) 2007/11/13
;; Deletes superfluous vertex (aligned or overlapped) in a lwpolyline
;; Keeps arcs and widthes.
;;
;; Arguments
;; pl : the polyline to be treated (ename)
;; tt : T ou nil
;;    - T deletes all vertex aligned or on the same arc
;;    - nil keeps vertex which come back on the pline traject

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

  (defun regular-width (p1 p2 p3 ws1 we1 ws2 we2 / delta norm)
    (setq delta (- we2 ws1)
    )
    (and (= we1 ws2)
(equal (/ (- (vlax-curve-getDistAtPoint pl (trans p2 pl 0))
      (vlax-curve-getDistAtPoint pl (trans p1 pl 0))
   )
   (- (vlax-curve-getDistAtPoint pl (trans p3 pl 0))
      (vlax-curve-getDistAtPoint pl (trans p1 pl 0))
   )
)
(/ (- we1 (- we2 delta)) delta)
0.01
)
    )
  )

  (setq elst (entget pl))
  (and (= 1 (logand 1 (cdr (assoc 70 elst)))) (setq closed T))
  (setq old-p  (vl-remove-if-not
(function (lambda (x) (= (car x) 10)))
elst
       )
old-sw (vl-remove-if-not
(function (lambda (x) (= (car x) 40)))
elst
       )
old-ew (vl-remove-if-not
(function (lambda (x) (= (car x) 41)))
elst
       )
old-b  (vl-remove-if-not
(function (lambda (x) (= (car x) 42)))
elst
       )
elst   (vl-remove-if
(function (lambda (x) (member (car x) '(10 40 41 42))))
elst
       )
  )
  (and closed (setq old-p (append old-p (list (car old-p)))))
  (while (cddr old-p)
    (if (or (= (cdar old-sw)
       (cdar old-ew)
       (cdadr old-sw)
       (cdadr old-ew)
    )
    (regular-width
      (cdar old-p)
      (cdadr old-p)
      (cdaddr old-p)
      (cdar old-sw)
      (cdar old-ew)
      (cdadr old-sw)
      (cdadr old-ew)
    )
)
      (if (and (zerop (cdar old-b))
       (zerop (cdadr old-b))
  )
(if
  (if tt
    (null (inters (cdar old-p)
  (cdaddr old-p)
  (cdar old-p)
  (cdadr old-p)
  )
    )
    (betweenp (cdar old-p) (cdaddr old-p) (cdadr old-p))
  )
   (setq old-p (cons (car old-p) (cddr old-p))
old-b (cons (car old-b) (cddr old-b))
old-sw (cons (car old-sw) (cddr old-sw))
old-ew (cons (cadr old-ew) (cddr old-ew))
   )
   (setq new-p (cons (car old-p) new-p)
new-b (cons (car old-b) new-b)
new-sw (cons (car old-sw) new-sw)
new-ew (cons (car old-ew) new-ew)
old-p (cdr old-p)
old-b (cdr old-b)
old-sw (cdr old-sw)
old-ew (cdr old-ew)
   )
)
(if
  (and
    (/= 0.0 (cdar old-b))
    (/= 0.0 (cdadr old-b))
    (equal (caddr
     (setq
       b1 (BulgeData (cdar old-b) (cdar old-p) (cdadr old-p))
     )
   )
   (caddr
     (setq b2
    (BulgeData (cdadr old-b) (cdadr old-p) (cdaddr old-p))
     )
   )
   1e-4
    )
    (or tt
(or (and (< 0 (car b1)) (< 0 (car b2)))
    (and (< (car b1) 0) (< (car b2) 0))
)
    )
  )
   (setq old-p (cons (car old-p) (cddr old-p))
old-b (cons (cons 42 (tan (/ (+ (car b1) (car b2)) 4.0)))
      (cddr old-b)
)
old-sw (cons (car old-sw) (cddr old-sw))
old-ew (cons (cadr old-ew) (cddr old-ew))
   )
   (setq new-p (cons (car old-p) new-p)
new-b (cons (car old-b) new-b)
new-sw (cons (car old-sw) new-sw)
new-ew (cons (car old-ew) new-ew)
old-p (cdr old-p)
old-b (cdr old-b)
old-sw (cdr old-sw)
old-ew (cdr old-ew)
   )
)
      )
      (setq new-p  (cons (car old-p) new-p)
    new-b  (cons (car old-b) new-b)
    new-sw (cons (car old-sw) new-sw)
    new-ew (cons (car old-ew) new-ew)
    old-p  (cdr old-p)
    old-b  (cdr old-b)
    old-sw (cdr old-sw)
    old-ew (cdr old-ew)
      )
    )
  )
  (if closed
    (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-sw (append (reverse new-sw) old-sw)
new-ew (append (reverse new-ew) old-ew)
  )
  (entmod
    (append elst
    (apply 'append
   (apply 'mapcar
  (cons 'list (list new-p new-sw new-ew new-b))
   )
    )
    )
  )
)

;;; 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)
  )
)

;;; TRUNC Returns the list from the first item to the first occurrence
;;; of expression de l'expression (complementary to MEMBER list)

(defun trunc (expr lst)
  (if (and lst
   (not (equal (car lst) expr))
      )
    (cons (car lst) (trunc expr (cdr 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))
« Last Edit: November 18, 2007, 04:21:31 PM by gile »
Speaking English as a French Frog

CAB

  • Global Moderator
  • Seagull
  • Posts: 10378
Re: How do you simplify a LWPolyline vertex?
« Reply #24 on: November 12, 2007, 11:52:31 AM »
That version works well in ACAD2000. 8-)
« Last Edit: November 12, 2007, 09:07:39 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.

MP

  • Seagull
  • Posts: 17530
Re: How do you simplify a LWPolyline vertex?
« Reply #25 on: November 12, 2007, 11:54:19 AM »
I should have said "not supported with A2000 and A2004." because it works fine with A2007, I use it a lot!

All the more reason to test me thinks.

:)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #26 on: November 13, 2007, 04:34:44 AM »
Hi gile and Alan and Michael,

These are comments from a program I wrote a couple years ago.
I was probably using 2004 at the time.

;; Set lwpline not closed and delete one vertex at a
;; time until two vertices remain. Avoids an "unwind error"
;; which occurs with lwplines when more than one vertex
;; is removed at a time.

Since then I haven't seen the unwind error when removing or adding
points in lwplines using the Coordinates property.

This evening I tested the idea in 2006 and 2008 using the following code.
What I found in 2006 was no error if only one point is removed.
If two or more points picked, unwind error, as I expected.
Also note, the lwpline is modified (two points removed) regardless of the
error. In 2008 there is no error when two or more points are removed.

So I don't think there's a problem modifying the Coordinates property
as long as the one-at-time rule is used. Obviously this applies to
recent versions as well for the sake of backwards compatibility.

I hope this sheds some light.

Code: [Select]
;; Returns a nested point list from a lwpline flat point list.
(defun PointList (obj / coord lst)
  (setq coord (vlax-get obj 'Coordinates))
  (repeat (/ (length coord) 2)
    (setq lst (cons (list (car coord) (cadr coord)) lst)
          coord (cddr coord)
    )
  )
  (reverse lst)
) ;end

;; Remove one or more vertices from a lwpline.
(defun c:RemovePoints ( / obj p lst ptlst)
  (setq obj (car (entsel "\nSelect pline: ")))
  (setq obj (vlax-ename->vla-object obj))
  (while (setq p (getpoint "\nPick point at vertex: "))
    (setq lst (cons p lst))
  )
  ;; remove Z coordinates
  (setq lst (mapcar '(lambda (x) (list (car x) (cadr x))) lst))
  (setq ptlst (PointList obj))
  (foreach x lst
    (setq ptlst (vl-remove x ptlst))
  )
  (vlax-put obj 'Coordinates (apply 'append ptlst))
) ;end

Joe Burke

  • Guest
Re: How do you simplify a LWPolyline vertex?
« Reply #27 on: November 13, 2007, 04:48:52 AM »
One other thought. My testing back when indicated the one-at-a-time idea does not apply to old style heavy plines. Only to lwplines.

Joe Burke

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

I think this is not correct since experience and dump object says otherwise.

("Coordinates" (70.326 22.6916 117.289 22.6916 ...) VISIBLE READONLY)

MP

  • Seagull
  • Posts: 17530
Re: How do you simplify a LWPolyline vertex?
« Reply #29 on: November 13, 2007, 08:46:35 AM »
You're absolutely right Joe.

There was a bug in the version of the program at that point. You can tell because all the properties in the post you refer to appear to be read only. Said bug has long been fixed but I had failed to notice it when making the post you caught.

Thanks for the heads up.

:)
\|// Set goal. Experiment tirelessly until
|Oo| practice has become expertise.  Loop.
|- | LinkedIn | Dropbox