Topic: Pline Weeder

[jbaxter]

Greetings,

Does anyone have a lisp routine that will globally remove vertex points from a selection set of contours but not destroying shape, linestyle, layering etc.

Regards,
John

[Dent Cermak]

Search this collection. I think I remember  such a lisp routine there. But then, I think I remamber 1965 too.

http://www.freecadapps.com/shareware.php

[hendie]

as can be observed from his physical coordination skills above ^^

[CAB]

Check this out.

http://theswamp.org/phpBB2/viewtopic.php?t=2024&highlight=weed

[jbaxter]

Thanks gents, much appreciated. I will give the routines a try.

Regards,
JB

[t-bear]

Soooooo.......John, where you been?  Haven't "seen" your smilin' face here in quite a while......

[jbaxter]

G'day Bear

Yeah, the boss has had me under the whip for a while.

Took me a while to find you after the cadalog site went belly up.

Tried those weeders however they all seem to want to change the linestyles, colours etc, is there one around that will leave things alone and just weed out the bulk vertices.

Regards,
JB

[CAB]

jbaxter

Here is an example of how it can be done. I just modified one of the
Pline Weed routines. Let me know how it works for you and is I missed
any of the pline attributes you wanted to preserve.

Code: [Select]

;|
   as posted to the autodesk newsgroup by
   Brian Hailey, on or around 4/23/03
   Function to weed unneeded vertices in a LWpolyline, 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)
                              )
                          )
              )
    )
    ;;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
    ;;  added by CAB 08/24/04 to include the following info if it exist
    (if (assoc 6 polys) ; Line Type
      (setq elist (append elist (list (assoc 6 polys))))
    )
    (if (assoc 48 polys) ; Line Type Scale
      (setq elist (append elist (list (assoc 48 polys))))
    )
    (if (assoc 62 polys) ; Color
      (setq elist (append elist (list (assoc 62 polys))))
    )
    (setq elist (append elist plist (list (assoc 210 polys))))
    ;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    (entmake elist)
    (entdel (ssname sel track))
    (setq track (1+ track))
  )
  (command "_.undo" "end")
  (princ)
)
(prompt "\nPolyline Weeder Loaded, Enter PVD to run.")
(princ)

[jbaxter]

Thanks, much appreciated. I will give it a try.

Kind regards,
JB

[jbaxter]

Unfortunately the routine seems to offer a global select but only acts upon the first polyline in the selection set.

I am using acad2004

Regards,
John

[CAB]

No the routine did not offer global selection, but this one does.

Code: [Select]

;|
   as posted to the autodesk newsgroup by
   Brian Hailey, on or around 4/23/03
   Function to weed unneeded vertices in a LWpolyline, 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: ")
        track 0
  )
 
  ;;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
  ;;  added by CAB 09/07/04 to allow select of ALL plines in drawing
  (prompt "\nSelect lwpolys to weed or Enter to select all: ")
  (cond ((SETQ sel (SSGET '((0 . "LWPOLYLINE"))))) ; user picked dimensions
      ((SETQ sel (SSGET "X" '((0 . "LWPOLYLINE"))))) ; all dimensions
  ) ;_ end of if
  ;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

  (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)
                              )
                          )
              )
    )
    ;;vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
    ;;  added by CAB 08/24/04 to include the following info if it exist
    (if (assoc 6 polys) ; Line Type
      (setq elist (append elist (list (assoc 6 polys))))
    )
    (if (assoc 48 polys) ; Line Type Scale
      (setq elist (append elist (list (assoc 48 polys))))
    )
    (if (assoc 62 polys) ; Color
      (setq elist (append elist (list (assoc 62 polys))))
    )
    (setq elist (append elist plist (list (assoc 210 polys))))
    ;;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    (entmake elist)
    (entdel (ssname sel track))
    (setq track (1+ track))
  )
  (command "_.undo" "end")
  (princ)
)
(prompt "\nPolyline Weeder Loaded, Enter PVD to run.")
(princ)