I think I would still go the MAESURE way. Tested R14 & A2K -David
;=======================================================================
; 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 =======================================