Author Topic: Pline Weeder  (Read 9475 times)

0 Members and 1 Guest are viewing this topic.

jbaxter

  • Guest
Pline Weeder
« on: August 20, 2004, 03:14:13 AM »
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

  • Guest
Pline Weeder
« Reply #1 on: August 20, 2004, 08:11:36 AM »
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

  • Guest
Pline Weeder
« Reply #2 on: August 20, 2004, 08:38:56 AM »
as can be observed from his physical coordination skills above ^^

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Pline Weeder
« Reply #3 on: August 20, 2004, 09:08:57 AM »
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.

jbaxter

  • Guest
Pline Weeder
« Reply #4 on: August 22, 2004, 07:48:11 PM »
Thanks gents, much appreciated. I will give the routines a try.

Regards,
JB

t-bear

  • Guest
Pline Weeder
« Reply #5 on: August 23, 2004, 08:19:10 AM »
Soooooo.......John, where you been?  Haven't "seen" your smilin' face here in quite a while......

jbaxter

  • Guest
Pline Weeder
« Reply #6 on: August 23, 2004, 07:56:23 PM »
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

  • Global Moderator
  • Seagull
  • Posts: 10401
Pline Weeder
« Reply #7 on: August 24, 2004, 10:15:43 AM »
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)
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.

jbaxter

  • Guest
Pline Weeder
« Reply #8 on: September 07, 2004, 02:56:11 AM »
Thanks, much appreciated. I will give it a try.

Kind regards,
JB

jbaxter

  • Guest
Pline Weeder
« Reply #9 on: September 07, 2004, 03:21:21 AM »
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

  • Global Moderator
  • Seagull
  • Posts: 10401
Pline Weeder
« Reply #10 on: September 07, 2004, 09:08:17 AM »
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)
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.