Topic: Weeding out pline veticies

[CADaver]

I've found several routines, but none work on LWPLINEs.  I have some converted topolines that have vertices every inch or so, but we only need one every 2 or 3 feet.  I could use something that will "straghten" some of these out.

Thanks.

[daron]

I believe Hendie made one of those not too long ago. I think I could use it too. Heeeendieee?!?

[Anonymous]

You could do it fairly easily if the the LWPOLYLINE has no bulges.  All stright line segments.

You could:

1) MEASURE the pline and create a new one from the points

2) DIVIDE ( same as above )

3) (entmake) skipping n number of vertices between the points.
  This would probably be the least accurate and hardest to code.

All would depnd on recording the first and last points and including them in the new line.

-David

[David Bethel]

Oops.

I forgot to log in.  -David

[CADaver]

You could do it fairly easily if the the LWPOLYLINE has no bulges.  All stright line segments.

You could:

1) MEASURE the pline and create a new one from the points

2) DIVIDE ( same as above )

3) (entmake) skipping n number of vertices between the points.
  This would probably be the least accurate and hardest to code.

All would depnd on recording the first and last points and including them in the new line.

-David

ummm... okay... there's 832 plines in the file that need to be "weeded" so that pretty much kills the first two.  There was an old routine that would weed vertices out of the old heavy plines, but it doesn't work on the lightweight versions.  I could break that one down and re-build it for the LWPs, I was just hoping it had been done already.

[CAB]

I could break that one down and re-build it for the LWPs, I was just hoping it had been done already.

Looks like the only route, I could only fine this one:

Code: [Select]

; Weeds out extranous verticies from a polyline

;=========================WEED.LSP===========================
;Jerry Workman CIS 70717,3564    December 28, 1987
;      Last modified February 21, 1991
;============================================================

Only deals with old style plines.

There were a couple if you want to buy some software.
http://www.cadlantic.com/Rev-R15-1.htm

Would not be a big deal to convert the old pline routine though.
CAB

[Jeff_M]

Well, you could just use CONVERTPOLY to make them the old style pline, run the weeding program, use CONVERTPOLY to bring 'em back to LWPlines.

Jeff

[Jeff_M]

And just after posting my last post, I found this in my collection of things....

Code: [Select]


;|
   as posted to the autodesk newsgroup by
   Brian Hailey, on or around 4/23/03
   Function to weed unneeded vertices in a polyline, usually
   used for contours.....
|;

(defun c:pvd (/ dist ang sel track polys temp plist pt1 pt2 pt3 cnt
      elist)
  (command "_.undo" "begin")
  (setq dist (getdist "\nmax dist between verts: ")
ang  (getreal "\nmax angle between segs: ")
  )
  (prompt "select lwpolys to weed: ")
  (setq sel   (ssget '((0 . "LWPOLYLINE")))
track 0
  )
  (while (< track (sslength sel))
    (setq polys (entget (ssname sel track))
  temp polys
  temp (while (/= (car (nth 0 temp)) 10)
  (setq temp (cdr temp))
)
  temp (reverse temp)
  temp (while (/= (car (nth 0 temp)) 42)
  (setq temp (cdr temp))
)
  temp (reverse temp)
    )
    (setq plist nil
  plist (append
  plist
  (list (nth 0 temp) (nth 1 temp) (nth 2 temp) (nth 3 temp))
)
  pt1 (cdr (nth 0 temp))
  pt2 (cdr (nth 4 temp))
  pt3 (cdr (nth 8 temp))
  cnt 0
    )
    (while (nth (+ cnt 8) temp)
      (setq pt1 (cdr (nth cnt temp))
    pt2 (cdr (nth (+ cnt 4) temp))
    pt3 (cdr (nth (+ cnt 8) temp))
      )
      (if (and (< (+ (distance pt1 pt2) (distance pt2 pt3)) dist)
       (< (abs (- (angle pt1 pt2) (angle pt2 pt3)))
  (* (/ ang 180.0) pi)
       )
  )
(setq temp (append
     (list (nth 0 temp)
   (nth 1 temp)
   (nth 2 temp)
   (nth 3 temp)
     )
     (member (nth 8 temp) temp)
   )
)
(setq plist (append
      plist
      (list (nth 4 temp)
    (nth 5 temp)
    (nth 6 temp)
    (nth 7 temp)
      )
    )
      temp  (cddddr temp)
)
      )
    )
    (setq plist (append
  plist
  (list (nth 4 temp)
(nth 5 temp)
(nth 6 temp)
(nth 7 temp)
  )
)
    )
    (setq elist (append
  (list
    (assoc 0 polys)
    (assoc 100 polys)
    (assoc 67 polys)
    (assoc 410 polys)
    (assoc 8 polys)
    (cons 100 "AcDbPolyline")
    (cons 90 (/ (length plist) 4))
    (assoc 70 polys)
  )
  (if (assoc 43 polys)
    (list
      (assoc 43 polys)
      (assoc 38 polys)
      (assoc 39 polys)
    )
    (list
      (assoc 38 polys)
      (assoc 39 polys)
    )
  )
  plist
  (list
    (assoc 210 polys)
  )
)
    )
    (entmake elist)
    (entdel (ssname sel track))
    (setq track (1+ track))
  )
  (command "_.undo" "end")
)

 

[CADaver]

And just after posting my last post, I found this in my collection of things....

 :genie:  Thanks Jeff, just what I was looking for.  Thanks everybody else for the effort. :dood:

[hendie]

I believe Hendie made one of those not too long ago. I think I could use it too. Heeeendieee?!?

thanks for remembering me so fondly Daron... unfortunately that was a "one-off" for someone that luckily seemed to work for a couple of different problems. It was for someone who had a load of 3 point leaders and wanted them changed to 2 point leaders
for anyone interested, the original post is back here and we discovered some interesting behaviour regarding vertex points on leaders

[David Bethel]

I think I would still go the MAESURE way.  Tested R14 & A2K  -David

Code: [Select]


;=======================================================================
;    LWPRed.Lsp                                    Aug 04, 2004
;    Reduce Vertices Numbers In LWPOLYLINES
;================== Start Program ======================================
(princ "\nCopyright (C) 2004, Fabricated Designs, Inc.")
(princ "\nLoading LWPRed v1.1 ")
(setq lwr_ nil lsp_file "LWPRed")

;================== Macros =============================================
(defun PDot ()(princ "."))

(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun lwr_smd ()
 (SetUndo)
 (setq olderr *error*
      *error* (lambda (e)
                (while (> (getvar "CMDACTIVE") 0)
                       (command))
                (and (/= e "quit / exit abort")
                     (princ (strcat "\nError: *** " e " *** ")))
                (and (= (logand (getvar "UNDOCTL") 8) 8)
                     (command "_.UNDO" "_END" "_.U"))
                (lwr_rmd))
       lwr_var '(("CMDECHO"   . 0) ("MENUECHO"   . 0)
                ("MENUCTL"   . 0) ("MACROTRACE" . 0)
                ("OSMODE"    . 0) ("SORTENTS"   . 119)
                ("BLIPMODE"  . 0) ("PDMODE"     . 0)
                ("SNAPMODE"  . 1) ("PLINEWID"   . 0)
                ("ORTHOMODE" . 1) ("GRIDMODE"   . 0)
                ("ELEVATION" . 0) ("THICKNESS"  . 0)
                ("HIGHLIGHT" . 1) ("REGENMODE"  . 1)
                ("COORDS"    . 0) ("MODEMACRO" . ".")
                ("CECOLOR"   . "BYLAYER")
                ("CELTYPE"   . "BYLAYER")))
 (foreach v lwr_var
   (and (getvar (car v))
        (setq lwr_rst (cons (cons (car v) (getvar (car v))) lwr_rst))
        (setvar (car v) (cdr v))))
 (princ (strcat (getvar "PLATFORM") " Release " (ver)
        " -  LWPOLYLINE Vertex Reduction ....\n"))
 (princ))

(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun lwr_rmd ()
  (setq *error* olderr)
  (foreach v lwr_rst (setvar (car v) (cdr v)))
  (command "_.UNDO" "_END")
  (prin1))

(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
 (and (zerop (getvar "UNDOCTL"))
      (command "_.UNDO" "_ALL"))
 (and (= (logand (getvar "UNDOCTL") 2) 2)
      (command "_.UNDO" "_CONTROL" "_ALL"))
 (and (= (logand (getvar "UNDOCTL") 8) 8)
      (command "_.UNDO" "_END"))
 (command "_.UNDO" "_GROUP"))

(PDot);++++++++++++ Multiple Association List ++++++++++++++++++++++++++
(defun massoc (key alist / nlist)
  (foreach x alist
    (if (eq key (car x))
        (setq nlist (cons (cdr x) nlist))))
  (reverse nlist))

(PDot);************ Main Program ***************************************
(defun lwr_ (/ olderr lwr_var lwr_rst dis  ss i en ed fp lp fe pp pl sa)
  (lwr_smd)

  (initget 6)
  (setq dis (getdist "\nDistance Between Vertices <1>:   "))
  (and (not dis)
       (setq dis 1))

  (and (setq ss (ssget '((0 . "LWPOLYLINE"))))
       (setq i (sslength ss))
       (while (not (minusp (setq i (1- i))))
              (setq en (ssname ss i)
                    ed (entget en)
                    pl (massoc 10 ed)
                    fp (car pl)
                    lp (last pl))
               (command "_.COPY" en "" '(0 0) '(0 0))
               (entdel en)
               (setq fe (entnext)
                     sa (ssadd)
                     pp nil)
               (command "_.MEASURE" fp dis)
               (while (setq fe (entnext fe))
                  (setq pp (cons (cdr (assoc 10 (entget fe))) pp))
                  (ssadd fe sa))
               (command "_.ERASE" sa ""
                        "_.PLINE" lp)
               (foreach p pp (command p))
               (command ""
                        "_.CHPROP" (entlast) ""
                        "_LA" (cdr (assoc 8 ed)))
               (if (assoc 6 ed)
                   (command "_LT" (cdr (assoc 6 ed))))
               (if (assoc 39 ed)
                   (command "_T" (cdr (assoc 39 ed))))
               (if (assoc 48 ed)
                   (command "_S" (cdr (assoc 48 ed))))
               (and (assoc 62 ed)
                    (not (zerop (cdr (assoc 62 ed))))
                    (command "_C" (cdr (assoc 62 ed))))
               (command "")))
  (lwr_rmd))

(PDot);************ Load Program ***************************************
(defun C:LWPRed () (lwr_))
(if lwr_ (princ "\nLWPRed Loaded\n"))
(prin1)
;|================== End Program =======================================