;; --------------------------------------------------------------------------------------------------- ;;
;; -- PEDIT_DELPKT : löscht gewählten Punkt auf gewählter Polylinie                                 -- ;;
;; --                ( egal ob (LW) / Leader / oder 2d-Poly )                                       -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun c:PEDIT_DELPKT ( / LINIE PUNKT)

;; -- Subfunktionen definieren....

;; --------------------------------------------------------------------------------------------------- ;;
;; -- SET_SYSVARS : Setzt Systemvariablen und gibt die alten Einstellungen in einer Liste zurück    -- ;;
;; --               d.h zum Beispiel am anfang der Routine                                          -- ;;
;; --               (setq SYS_SAVES (SET_SYSVARS '( ("CMDECHO" 0) ("FILEDIA" 0) ))) aufrufen        -- ;;
;; --               und am Ende mit (SET_SYSVARS SYS_SAVES) Originalzustand wieder herstellen       -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
;; -- P.S. Funktion liegt für den globalen Zugriff gewöhnlich in einer Lispbibliothek               -- ;;
(defun SET_SYSVARS ( SYSVARLISTE / SAVES)
  (if (=(type SYSVARLISTE) 'LIST)    
    (foreach VARIABLE SYSVARLISTE
      (if (=(type VARIABLE) 'LIST)mapcar
	(if (=(length VARIABLE) 2)
	  (if (=(type(car VARIABLE)) 'STR)
	    (if (Getvar (car VARIABLE))                       ; konnte Systemvariable ausgelesen werden ?
	      (progn		
	        (setq SAVES (append SAVES (list (list (car VARIABLE) (getvar (car Variable))))))                
		(setvar (car Variable) (cadr Variable))
	      )					
            )	 
	  )
	)  
      )
    )
  )
  SAVES
)
;; --------------------------------------------------------------------------------------------------- ;;




  
;; --------------------------------------------------------------------------------------------------- ;;
;; -- PEDITX_1 : Funktion zur Polylinienbearbeitung ( Löschen eines Punktes)                        -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun PEDITX_1 (POLYLINIE LINIENPUNKT TOLERANZ /
                 OBJEKTDATEN VERTEXDATEN TEMPLINE POINTFOUND)
  (if (and(=(type POLYLINIE) 'ENAME)
          (if (=(type LINIENPUNKT) 'LIST)
            (if (=(length LINIENPUNKT) 3)
              (if (and(= (type(car   LINIENPUNKT)) 'REAL)
                      (= (type(cadr  LINIENPUNKT)) 'REAL)
                      (= (type(caddr LINIENPUNKT)) 'REAL)) T)))
          (if (=(type TOLERANZ) 'REAL)
            (if (> Toleranz 0) T)))                                                ; Eingabeparameter o.k
    (progn        
      (setq OBJEKTDATEN (entget POLYLINIE))                             ; Objektdaten der Polylinie holen
      (cond
        ((= (cdr (assoc 0 OBJEKTDATEN)) "LWPOLYLINE")                        ; eine LWPOLYLINE ?, dann...
          (setq LINIENPUNKT (list (car LINIENPUNKT) (cadr LINIENPUNKT)))        ; nur X und Y Wert merken
          (while  OBJEKTDATEN                                        ; Daten der Polylinie durchlaufen...
            (if (or (/= (caar OBJEKTDATEN) 10)                   ; ist Eintrag keine Koordinate ? oder...
                    (not (equal (cdar OBJEKTDATEN) LINIENPUNKT TOLERANZ)))    ; nicht der gewähltem Punkt
              (progn                                                                            ; .. dann
                (setq TEMPLINE  (cons (car OBJEKTDATEN) TEMPLINE)) ; Daten unverändert übernehmen und ...
                (setq OBJEKTDATEN (cdr OBJEKTDATEN))      ; Objektdaten für nächsten Durchlauf reduzieren
              )                                 ;... sonst (d.h. zu löschender Stützpunkt gefunden !!) ..
              (progn  
                (setq OBJEKTDATEN (cddddr OBJEKTDATEN)); vier Einträge entfernen (Punkt,Anfangsbreite...)
                (setq POINTFOUND 'T)
              )
            ) 
          )                                                                                 ; end [WHILE]
          (entmod (reverse TEMPLINE))                                 ; Polylinie mit neuen Daten updaten
        )                                                                  ; end [Bedingung "LWPOLYLINE"]

        
        ((= (cdr (assoc 0 OBJEKTDATEN)) "LEADER")                                      ; eine Führung ???
          (while  OBJEKTDATEN                                          ; Daten der Führung durchlaufen...
            (if (or (/= (caar OBJEKTDATEN) 10)                   ; ist Eintrag keine Koordinate ? oder...
                    (not (equal (cdar OBJEKTDATEN) LINIENPUNKT TOLERANZ)))    ; nicht der gewähltem Punkt
              (progn                                                                            ; .. dann
                (setq TEMPLINE  (cons (car OBJEKTDATEN) TEMPLINE)) ; Daten unverändert übernehmen und ...
                (setq OBJEKTDATEN (cdr OBJEKTDATEN))      ; Objektdaten für nächsten Durchlauf reduzieren
              )                                 ;... sonst (d.h. zu löschender Stützpunkt gefunden !!) ..
              (progn  
                (setq OBJEKTDATEN (cdr OBJEKTDATEN))           ; Punkt entfernen (Punkt,Anfangsbreite...)
                (setq POINTFOUND 'T)
              )
            ) 
          )                                                                                 ; end [WHILE]
          (entmod (reverse TEMPLINE))                                 ; Polylinie mit neuen Daten updaten
        ) 
        
        
        ((= (cdr (assoc 0 OBJEKTDATEN)) "POLYLINE")                             ; eine Heavy-POLYLINE ?!!
         (princ "\n\n LINIE:\n")
         (setq VERTEXDATEN (entget (entnext (cdr (assoc -1 OBJEKTDATEN))))) ; Daten erstes Punkt-Objekte
         (while (and  (not POINTFOUND)(= (cdr (assoc 0 VERTEXDATEN)) "VERTEX"))
           (princ "\n\n PUNKT:\n")           
           (if (equal (cdr (assoc 10 VERTEXDATEN)) LINIENPUNKT TOLERANZ)        ; Koordinaten vergleichen
             (progn                                                      ; bei pos. Befund Vertex löschen
               (setq POINTFOUND 'T)               
               (vl-load-com)
               (setq VERTEXDATEN  (vlax-ename->vla-object (cdr (assoc -1 VERTEXDATEN))))
               (setq OBJEKTDATEN  (vla-ObjectIdToObject (vla-get-ActiveDocument (vlax-get-acad-object))
                                  (vla-get-OwnerID VERTEXDATEN)))
               (vla-Delete VERTEXDATEN)
               (vla-update OBJEKTDATEN)                              
             )
             (setq VERTEXDATEN (entget (entnext (cdr (assoc -1 VERTEXDATEN)))))   ; nächstes Punkt-Objekt
           )           
         )                                                                         ; end [WHILE "VERTEX"]
        )
      )                                                                                      ; end [COND]
      (if (not POINTFOUND) (princ "\nGewählter Punkt liegt nicht auf der Polylinie !!\n"))
    )
  )  
)                                                                                           ; end [DEFUN]
;; --------------------------------------------------------------------------------------------------- ;;


;; --------------------------------------------------------------------------------------------------- ;;
;;  LINE_OK : Testet ob Objekt eine Polylinie ist, un ob mehr als 2 Punkte vorhanden sind           -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun LINE_OK ( LINIE / OBJEKTDATEN OBJEKTDATEN2 PKTANZAHL RETURN)  
  (if (=(type LINIE) 'ENAME)                                                   ;... Wirklich ein Objekt ?
    (progn
      (setq OBJEKTDATEN (entget LINIE))                                 ; Objektdaten der Polylinie holen
      (setq PKTANZAHL 0)

      (cond
        ((or(= (cdr (assoc 0 OBJEKTDATEN)) "LWPOLYLINE")                              ; eine LWPOLYLINE ?
            (= (cdr (assoc 0 OBJEKTDATEN)) "LEADER"))                        ; oder eine Führung, dann...
          (foreach EINTRAG OBJEKTDATEN
            (if(= (car EINTRAG) 10)                                                         ; ein Punkt ?
              (setq PKTANZAHL (1+ PKTANZAHL))
            )
          )         
          (setq RETURN (> PKTANZAHL 2))                  ; und mehr als 2 Punkte ? ... dann ist alles o.k
        )
        ((= (cdr (assoc 0 OBJEKTDATEN)) "POLYLINE"); eine Heavy-POLYLINE (bestehend aus Punkt-Objekten) ?
          (setq OBJEKTDATEN2 (entget (entnext (cdr (assoc -1 OBJEKTDATEN)))))  ; Daten erster Punkt holen
          (while (= (cdr (assoc 0 OBJEKTDATEN2)) "VERTEX")
            (setq PKTANZAHL (1+ PKTANZAHL))          
            (setq OBJEKTDATEN2 (entget (entnext (cdr (assoc -1 OBJEKTDATEN2)))))         ; nächster Punkt
          )                                                                        ; end [WHILE "VERTEX"]
          (setq RETURN (> PKTANZAHL 2))                  ; und mehr als 2 Punkte ? ... dann ist alles o.k
        )                       
      )                                                                                       ;end [COND]
    )
  )

  (if (not Return)
    (princ "\n Objekt keine Polylinie oder zu wenig Stützpunkte! ==> Abbruch\n")
  )  
  RETURN
)  
;; --------------------------------------------------------------------------------------------------- ;;
;; -- Rest der "kommandierten" Funktion ....
  
  (setq *Func_ERROR* *ERROR* )                                                ; alte Fehlerroutine merken
  (setq *ERROR*  PEDIT_DELPKT_FEHLER)                            ; eigene Fehlerbehandlungsroutine setzen
  (setq SYSVARS (SET_SYSVARS '( ("CMDECHO" 0) ("OSMODE" 1) )))       ; Systenvariablen speichern + setzen
  (command "_undo" "_MARK")                                      ; Markierung für "Zurückfunktion" setzen

  
  (setq Linie (car (entsel "Polylinie wählen: ")))                     ; <Objektname> der Polylinie holen
 
  (setq Punkt 'T)
  (while (and Punkt (LINE_OK LINIE))    
     (princ "\n")
     (setq Punkt (getpoint "Stützpunkt wählen: <Ende> "))                             ; Stützpunkt wählen
     (PEDITX_1 LINIE PUNKT 0.0001)
      
     (command "neuzeich")                                                        ; Zeichnung regenerieren
  )
        
  (SET_SYSVARS SYSVARS)  
  (setq *ERROR* *Func_ERROR*)                                      ; alten Fehlerhandler rückinstallieren
  (setq *Func_ERROR* nil)                                                    ; Spuren im Speicher löschen
  (setq SYSVARS nil)
  (princ)                                                                 ; ... und ohne Rückgabe beenden
)                                                                           ; end [DEFUN "c:PEDIT_DELPKT"
;; --------------------------------------------------------------------------------------------------- ;;


;; --------------------------------------------------------------------------------------------------- ;;
;; -- FUNKTIONSFEHLER : Funktionseigene Fehlerroutine                                               -- ;;
;; --------------------------------------------------------------------------------------------------- ;;
(defun PEDIT_DELPKT_FEHLER(S)
  (if (/= s "Funktion abgebrochen")
    (progn
      (print (strcat "Fehler : " S))                                                      ; Fehlerausgabe
      (command "_undo" "_BACK")                     ; alle Änderungen ab Funktionsbeginn Rückgängigmachen
    )  
  )
  (SET_SYSVARS SYSVARS)  
  (setq *ERROR* *Func_ERROR*)                                      ; alten Fehlerhandler rückinstallieren
  (setq *Func_ERROR* nil)                                                    ; Spuren im Speicher löschen
  (setq SYSVARS nil)
  (princ)                                                                 ; ... und ohne Rückgabe beenden
)
;; --------------------------------------------------------------------------------------------------- ;;