Author Topic: Find and fix polylines with only one vertex (Acad 2008)  (Read 5080 times)

0 Members and 1 Guest are viewing this topic.

Peter2

  • Swamp Rat
  • Posts: 650
Find and fix polylines with only one vertex (Acad 2008)
« on: October 22, 2019, 12:31:05 PM »
On Acad 2008 we have an old app (which can not be fixed ...) which causes sometimes a crash.
When we open the crashed DWG again (with 2008 or 2018) we get the message:

Code: [Select]
Einer 2D-Polylinie (1C8FB5) mit nur einem Kontrollpunkt wurde ein Kontrollpunkt hinzugefügt.
To a 2D-polyline (..) with only one vertex was added a vertex.

Anyone here who has experience and solutions with this problem?
I think I can't avoid it, but I hope to fix it before crashing ....
« Last Edit: October 23, 2019, 02:55:42 AM by Peter2 »
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

kpblc

  • Bull Frog
  • Posts: 396
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #1 on: October 22, 2019, 04:12:28 PM »
Without code (sorry, it's too late for me):
You can oen drawging by ObjectDBX and check all entities within all block definitions. In cse entity is LWPOLYLINE and has only one vertex, erase this enity or add one more vertex to it.
Sorry for my English.

PKENEWELL

  • Bull Frog
  • Posts: 309
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #2 on: October 23, 2019, 03:18:23 PM »
Try running the following routine in the drawing. Let me know if this solves the issue. EDIT. Forgot to add the (pjk-Massoc) routine - corrected.

Code: [Select]
(defun c:NULLP ( / bad cnt el en et fuzz pel pen pl ss tcnt)
   (setq cnt 0 tcnt 0 fuzz 1e-11)
   (princ "\n\nSearching Zero Length Polylines...")
   (if (setq ss (ssget "X" (list (cons 0 "*POLYLINE"))))
      (repeat (sslength ss)
         (setq en (ssname ss cnt) el (entget en) et (cdr (assoc 0 el)) cnt (1+ cnt) bad nil)
         (cond
            ((= et "LWPOLYLINE")
               (setq pl  (mapcar 'cdr (pjk-Massoc el 10))
                     f   (car pl)
                     bad (or (= (length pl) 1)(apply '= (mapcar (function (lambda (x)(equal x f fuzz))) pl)))
               )
            )
            ((= et "POLYLINE")
               (setq pen (entnext en))
               (while (and pen (= (cdr (assoc 0 (setq pel (entget pen)))) "VERTEX"))
                  (setq pl  (reverse (cons (cdr (assoc 10 pel)) (reverse pl)))
                        pen (entnext pen)
                  )
               )
               (setq f   (car pl)
                     bad (or (= (length pl) 1)(apply '= (mapcar (function (lambda (x)(equal x f fuzz))) pl)))
               )
            )
         )
         (if bad (progn (entdel en)(setq tcnt (1+ tcnt))))
      )
   )
   (princ (strcat "\nRemoved (" (itoa tcnt) ") Zero Length Polylines"))
   (princ)
)

(defun pjk-Massoc (el dxf)
   (vl-remove-if 'null
      (mapcar (function (lambda (x)(if (= (car x) dxf) x nil))) el)
   )
)
« Last Edit: October 23, 2019, 03:25:43 PM by PKENEWELL »
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

Peter2

  • Swamp Rat
  • Posts: 650
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #3 on: October 24, 2019, 04:56:14 AM »
@PKENEWELL

thanks a lot - works fine.

In the meantime I found out that

- "qselect" for "polylines with length = 0" also find these lines
- "_audit" does not care about these lines (although opening a file with 1-vertex-plines stars an automatic repair)
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

kpblc

  • Bull Frog
  • Posts: 396
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #4 on: October 24, 2019, 06:20:15 AM »
Another code:
Code - Auto/Visual Lisp: [Select]
  1. (defun t1 (/ adoc layers count)
  2.   (setq count '(("len" . 0) ("txt" . 0)))
  3.   (vlax-for item (vla-get-layers adoc)
  4.     (setq layers (cons (cons item
  5.                              (mapcar (function (lambda (pr / temp)
  6.                                                  (setq temp (vlax-get-property item pr))
  7.                                                  (vl-catch-all-apply (function (lambda () (vlax-put-property item pr :vlax-false))))
  8.                                                  (cons pr temp)
  9.                                                  ) ;_ end of lambda
  10.                                                ) ;_ end of function
  11.                                      '("freeze" "lock")
  12.                                      ) ;_ end of mapcar
  13.                              ) ;_ end of list
  14.                        layers
  15.                        ) ;_ end of cons
  16.           ) ;_ end of setq
  17.     ) ;_ end of vlax-for
  18.   (vlax-for def (vla-get-blocks adoc)
  19.     (if (equal (vla-get-isxref def) :vlax-false)
  20.       (vlax-for ent def
  21.         (cond ((and (vlax-property-available-p ent "length") (equal (vla-get-length ent) 0. 1e-5))
  22.                (vla-erase ent)
  23.                (setq count (subst (cons "len" (1+ (cdr (assoc "len" count)))) (assoc "len" count) count))
  24.                )
  25.               ((and (vlax-property-available-p ent "textstring")
  26.                     (= (vl-string-trim " " (vla-get-textstring ent)) "")
  27.                     ) ;_ end of and
  28.                (vla-erase ent)
  29.                (setq count (subst (cons "txt" (1+ (cdr (assoc "len" count)))) (assoc "txt" count) count))
  30.                )
  31.               ) ;_ end of cond
  32.         ) ;_ end of vlax-for
  33.       ) ;_ end of if
  34.     ) ;_ end of vlax-for
  35.   (foreach item layers
  36.     (foreach pr (cdr item)
  37.       (vl-catch-all-apply (function (lambda () (vlax-put-property (car item) (car pr) (cdr pr)))))
  38.       ) ;_ end of foreach
  39.     ) ;_ end of foreach
  40.   (if (setq count (vl-remove-if (function (lambda (x) (= (cdr x) 0))) count))
  41.                   (mapcar (function (lambda (x)
  42.                                       (strcat "\nErased "
  43.                                               (itoa (cdr x))
  44.                                               (cond ((= (car x) "len") " entities with zero length")
  45.                                                     ((= (car x) "txt") " text with empty strings")
  46.                                                     ) ;_ end of cond
  47.                                               ) ;_ end of strcat
  48.                                       ) ;_ end of lambda
  49.                                     ) ;_ end of function
  50.                           ) ;_ end of mapcar
  51.                   ) ;_ end of apply
  52.            ) ;_ end of princ
  53.     ) ;_ end of if
  54.   (vla-endundomark adoc)
  55.   (princ)
  56.   ) ;_ end of defun
Without testing.
Sorry for my English.

PKENEWELL

  • Bull Frog
  • Posts: 309
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #5 on: October 24, 2019, 12:18:38 PM »
@PKENEWELL

thanks a lot - works fine.

In the meantime I found out that

- "qselect" for "polylines with length = 0" also find these lines
- "_audit" does not care about these lines (although opening a file with 1-vertex-plines stars an automatic repair)

Great to hear it worked for you!  :-)
Also cool bit of knowledge with the "qselect" command - I did not know you could do that.
« Last Edit: October 24, 2019, 12:23:25 PM by PKENEWELL »
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

Lonnie

  • Newt
  • Posts: 169
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #6 on: October 24, 2019, 03:02:37 PM »
Doesn't purge remove zero length objects?

ronjonp

  • Needs a day job
  • Posts: 7526
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #7 on: October 24, 2019, 03:12:28 PM »
Doesn't purge remove zero length objects?
On later versions yes .. not sure when it was introduced :)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Lonnie

  • Newt
  • Posts: 169
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #8 on: October 24, 2019, 03:45:17 PM »
At least 2010 I am thinking release 9 but that I can't be sure of.
« Last Edit: October 24, 2019, 03:49:26 PM by Lonnie »

Peter2

  • Swamp Rat
  • Posts: 650
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #9 on: October 25, 2019, 02:52:11 AM »
My remarks to "purge zero-length plines"

a) in 2008 it does not exist in "purge"
b) for me, I need to find and select the lines, not the purge them

Thanks again for contributions.
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

PKENEWELL

  • Bull Frog
  • Posts: 309
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #10 on: October 25, 2019, 11:12:59 AM »
My remarks to "purge zero-length plines"

a) in 2008 it does not exist in "purge"
b) for me, I need to find and select the lines, not the purge them

Thanks again for contributions.

Just curious - Why would you need to keep Zero length Polylines? Are they being used to identify something in the imported drawing that you need?
"When you are asked if you can do a job, tell 'em, 'Certainly I can!' Then get busy and find out how to do it." - Theodore Roosevelt

Peter2

  • Swamp Rat
  • Posts: 650
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #11 on: October 25, 2019, 11:22:13 AM »
...Are they being used to identify something in the imported drawing that you need?
Yes. They come out of a database with incorrect data, and with the lines we can find the problems in the database.
Peter

AutoCAD Map 3D 2023 German (so some technical terms will be badly retranslated to English)
BricsCAD V23

ahsattarian

  • Newt
  • Posts: 112
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #12 on: December 02, 2020, 12:01:53 PM »
This helps U   :




Code - Auto/Visual Lisp: [Select]
  1. (defun c:a ()
  2.   (setq i 0)
  3.   (if (setq ss (ssget "x" '((0 . "polyline"))))
  4.     (progn
  5.       (setq n (sslength ss))
  6.       (setq k -1)
  7.       (repeat n
  8.         (setq k (1+ k))
  9.         (setq s (ssname ss k))
  10.         (cond
  11.           ((= (strcase (cdr (assoc 0 (entget (entnext (entnext s))))) t) "seqend")
  12.            (entdel s)
  13.            (setq i (1+ i))
  14.           )
  15.         )
  16.       )
  17.     )
  18.   )
  19.   (if (> i 0)
  20.     (princ (strcat " Found and killed " (itoa i) " Single Vertex Plines !!  "))
  21.     (princ " No Single Vertex Polylines Found !!  ")
  22.   )
  23. )
  24.  




ronjonp

  • Needs a day job
  • Posts: 7526
Re: Find and fix polylines with only one vertex (Acad 2008)
« Reply #13 on: December 02, 2020, 02:13:34 PM »
@ahsattarian FWIW, You should localize your variables in your code:
Code: [Select]
(defun c:a (/ i k n s ss)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC