(defun c:plg (/ uu umgpl kelt genauigk)
  (setvar "CMDECHO" 0)
  (command "_.undo" "_G")
  (arxload "geomcal.arx" (princ "."))
  (while (not(setq uu(entsel))))
  (setq umgpl (car uu)
        kelt (cdr (assoc 0 (entget umgpl)))
        genauigk 1.0
        )
  (if (= kelt "LWPOLYLINE")
    (aktpl (entget umgpl) (reduz (subpl (entget umgpl)(cdr(assoc 70 (entget umgpl))) genauigk) (cdr(assoc 70 (entget umgpl)))))
    (princ "Keine Polylinie gewählt!")
    )
  (command "_.undo" "_E")
  (princ)
  )
(defun aktpl (pldat plpt / z)
    (delequalvtx(entmod(apply 'append (mapcar '(lambda (X)
                                     (if (= (car X) 10)
                                       (if (member (cdr X) plpt)
                                         (progn
                                           (setq z 0)
                                           (list X)
                                           )
                                         (setq z nil)
                                         )
                                       (progn
                                         (if (member (car X) '( 40 41 42))
                                           (if (and z (< z 3))
                                             (progn
                                               (setq z (1+ z))
                                               (list X)
                                               )
                                             (setq z nil)
                                             )
                                           (list X)
                                           )
                                         )
                                       )
                                     )
                                  pldat
                                  )
                  )
           ))
  )
(defun delequalvtx (edata / edata modd pliste lpt)
  (setq pliste'()
        point (list (car point) (cadr point))
        )
  (while edata
    (if (or
          (/= (caar edata) 10)
          (not (equal lpt (cdar edata) 0.000001))
          )
      (setq modd  (cons (car edata) modd)
            lpt (if (= (caar edata) 10)(cdar edata) lpt)
            edata (cdr edata)
            )
      (setq edata (cddddr edata))
      )
    )
  (entmod (reverse modd))
  )
(defun subpl (geli og genauigk / plptli plsegmpt)
  (setq plptli (apply
                 'append
                 (mapcar
                   '(lambda (X)
                        (if (= 10 (car X))
                          (setq pt10ue (list (cdr X)))
                          )
                      )
                   geli
                   )
                 )
        )
  (if (= og 1)
    (setq plptli (append plptli (list (nth 0 plptli))))
    )
  (princ)
  plptli
)
;;;
(defun reduz ( pli ogs / z upli p1 p2 p3 uri1 uri2 urili absp1)
  (setq z 2)
  (setq upli (list);(list (nth 0 pli))
	p1 (nth 0 pli)
	p2 (nth 1 pli)
	absp1 p1
	)
  (repeat (- (length pli) 2)
    (setq  p3 (nth z pli)
	   uri1 (cal "vec1(p1,p2)")
	   uri2 (cal "vec1(p2,p3)")
	   z (1+ z)
	   p1 p2
	   p2 p3
	   )
    (if (not(equal uri1 uri2 0.0001))
      (setq urili (list p1))
      (setq urili nil)
      )
    (if urili
      (setq upli (append upli urili))
      )
    );repeat
  (if upli
    (progn
      (setq p1 absp1
            p2 (nth 0 upli)
            p3 (nth (1- (length upli)) upli)
            uri1 (cal "vec1(p3,p1)")
            uri2 (cal "vec1(p1,p2)")
            )
      (if (not(equal uri1 uri2 0.0001))
        (setq upli (append (list p1) upli))
        )
      (setq upli (append upli (list(nth 0 upli))))
      (if (/= 1 ogs)
        (setq upli (append (cons (car pli) upli) (list (last pli))))
        )
      )
    (setq upli (list (car pli)(last pli)))
    )
  upli
  )
(princ "\nEntfernen überflüssiger LWPolylinien-Kontrollpunkte")
(princ "\nCADlon - Lisp over night!")
(princ "\nhttp://www.cadlon.de")
(princ "\nHolger Brischke")
(princ "\nkontakt@cadlon.de")
(princ "\nStart mit \"plg\"")
(princ)