;;;  Diese Lisproutine soll dazu dienen einen Umring auf einem
;;;  Teilbereich einer LW-/Polylinie zu erstellen
;;;  so als würde man eine Polylinie über die Außenkante von Bändern zeichnen
;;;  siehe dazu auch den Beitrag im Forum von www.cad.de
;;;  http://ww3.cad.de/foren/ubb/Forum145/HTML/001677.shtml
;;;  Mit freundlicher Unterstützung von
;;;  Marc Scherer, Holger Brischke, Jörn Bosse, Thomas Krüger


(vl-load-com)

(defun
   *ERROR*
          (MSG)
  (SVAR_OUT *SVIN)
  (princ MSG)
  (exit)
  (princ)
  ) ;_ Ende von DEFUN

;;; ---------------------------------------------------------------------------------
;;;             FUNKTION AKTUELLE SYSTEMVARIABLEN LESEN
(defun
   SETVAR_INP
             (SV)
  (setq *SVIN '())
  (repeat (length SV)
    (setq
      *SVIN
       (append
         *SVIN
         (list (list (car SV) (getvar (car SV))))
         )
      )
    (setq SV (cdr SV))
    )
  )

;;; ---------------------------------------------------------------------------------
;;;             FUNKTION ALTE SYSTEMVARIABLE SETZEN
(defun
   SETVAR_OUT
             (SV)
  (repeat (length SV)
    (setvar (caar SV) (cadar SV))
    (setq SV (cdr SV))
    )
  (setq *SVIN '())
  )

;;; ---------------------------------------------------------------------------------
;;;             FUNKTION TEMPORAERE SYSTEMVARIABLE SETZEN
;;;(defun
;;;   SVAR_PUT  ()
;;;  (mapcar
;;;    'setvar
;;;    '("cmdecho" "osmode")
;;;    '(0 0)
;;;    )
;;;  (setvar "angbase" 0)
;;;  )

;;; ---------------------------------------------------------------------------------
;;;  Koordinaten einer LW-/Polylinie auslesen
;;;  Format Koordinatenliste LWPl ( x y x y x y ...)
;;;  Format Koordinatenliste Pl ( x y z x y z x y z ...)
(defun
   GET-COORDINATES
                  (ENAME / POINTS)
  (setq AX-OBJ (vlax-ename->vla-object ENAME)) ;_ LISP-Objektname -> AX-Objekt
  (setq
    POINTS
     (vlax-safearray->list
       (vlax-variant-value
         (vlax-get-property AX-OBJ 'COORDINATES)
         ;; oder (vla-get-coordinates AX-OBJ)
         ) ;_ end of vlax-variant-value
       ) ;_ end of vlax-safearray->list
    ) ;_ end of setq
  ) ;_ end of defun

;;; ---------------------------------------------------------------------------------
;;; Format Koordintenliste ändern 
;;; (1x 1y 2x 2y nx ny) -> ((1x 1y 0.0)(2x 2y 0.0)(n xny 0.0))
(defun
   VLAX-GET-COORDINATES-XY->COORDLIST
                                     (PKTLIST / COORD-LST N)
  (setq N 0)
  (repeat (/ (length PKTLIST) 2)
    (setq
      COORD-LST
       (cons (list (nth N PKTLIST) (nth (+ N 1) PKTLIST) 0.0) COORD-LST)
      N (+ N 2))
    ) ;_ end of repeat
  (setq COORD-LST (reverse COORD-LST))
  ) ;_ end of defun

;;; ---------------------------------------------------------------------------------
;;; Format Koordintenliste ändern 
;;; (1x 1y 1z 2x 2y 2z nx ny nz) -> ((1x 1y 1z)(2x 2y 2z)(nx ny nz))
(defun
   VLAX-GET-COORDINATES-XYZ->COORDLIST
                                      (PKTLIST / COORD-LST N)
  (setq N 0)
  (repeat (/ (length PKTLIST) 3)
    (setq
      COORD-LST
       (cons
         (list
           (nth N PKTLIST)
           (nth (+ N 1) PKTLIST)
           (nth (+ N 2) PKTLIST)
           ) ;_ end of list
         COORD-LST
         ) ;_ end of cons
      N (+ N 3)
      ) ;_ end of setq
    ) ;_ end of repeat
  (setq COORD-LST (reverse COORD-LST))
  ) ;_ end of defun

;;; ---------------------------------------------------------------------------------
;;;  Distazen auf LW-/Polylinie zu Koordinatenpaar aus Koordinatenliste
;;; Format Koordinatenliste  ( (x y z) (x y z) (x y z) ...)
(defun
   CALCULATE-DISTANCE
                     (ENAME PKTLIST / DISTANCELIST AX-OBJ)
  (setq AX-OBJ (vlax-ename->vla-object ENAME)) ;_ LISP-Objektname -> AX-Objekt
  ;; (setq DISTANCELIST (mapcar '(lambda (ARG) (vlax-curve-getdistatpoint AX-OBJ ARG)) PKTLIST));_ sollte funktionieren
  ;; vlax-curve-getdistatpoint gibt aber nicht immer das zurück was es sollte (Holger Brischke cad.de)
  ;; deshalb der Umweg über (vlax-curve-getdistatparam(vlax-curve-getparamatpoint 
  (setq
    DISTANCELIST
     (mapcar
       '(lambda (ARG) (vlax-curve-getdistatparam AX-OBJ (vlax-curve-getparamatpoint AX-OBJ ARG)))
       PKTLIST))

  ) ;_ end of defun

;;; ---------------------------------------------------------------------------------
;;;  Koordinatenliste entsprechend Punktliste
(defun
   GET-CLOSEST-4-LST
                    (ENAME PKTLIST / POINTS AX-OBJ)
  (setq AX-OBJ (vlax-ename->vla-object ENAME)) ;_ LISP-Objektname -> AX-Objekt
  (setq
    POINTS
     (mapcar '(lambda (ARG) (vlax-curve-getclosestpointto AX-OBJ ARG)) PKTLIST)
    ) ;_ end of setq
  ) ;_ end of defun
;; erzeugen einer Dummy-Teil-Polylinie = Achse Schutzrohr

;;; ---------------------------------------------------------------------------------
;;;  Polylinie zeichnen
(defun
   DRAW-PL
          (POINTS / POINTS)
  (entmake
    (list
      '(0 . "POLYLINE")
          ; '(66 . 1)
          ; '(70 . 9)
      )
    )
  (foreach
     VTX
        POINTS
    (entmake
      (list
        '(0 . "VERTEX")
        (cons 10 VTX)
          ;'(70 . 32)
        )
      )
    )
  (entmake '((0 . "SEQEND")))
  )

;;; ---------------------------------------------------------------------------------
;;;  DUMMY Objekt löschen
(defun
   DUMMY_ERASE
              (ENAME / AX-OBJ)
  (setq AX-OBJ (vlax-ename->vla-object ENAME)) ;_ LISP-Objektname -> AX-Objekt
  (vla-erase AX-OBJ)
  )

;;; ---------------------------------------------------------------------------------
;;;
;;;   H  A  U  P  T  P  R  O  G  R  A  M  M
;;;
(princ "\nUmring/Schutzrohr auf Polylinien erzeugen. Start mit pl_around")
(defun
   C:PL_AROUND
              (/                  ENAME              STARTPUNKT         ENDPUNKT           AX-OBJ             POINTS
               POINTS-LST         POINTS-DISTANCES-LST                  DIST-POINTS-LST    START-END-LST
               START-END-DISTANCES-LST               DIST-START-END-POINT-LST              DN-SR              RECHTS
               SEITENPUNKT        DUMMY-PL           DUMMY-SR-LINKS     DUMMY-SR-RECHTS    AX-OBJ             POINTS-LST-LINKS
               POINTS-LST-RECHTS  SV                 *SVIN)


  (SETVAR_INP '("cmdecho" "osmode"))
  ;; sichern aktuelle Systemvariablen
  ;;  (SETVAR_PUT ) ;; Setzen von Systemvarablen
  (setvar "CMDECHO" 0)
  (while (= DN-SR NIL)
    (setq DN-SR (getreal "\nNennweite Schutzrohr / Breite Umring [m]: "))
    )
  (if (<= DN-SR 0)( setq DN-SR (* DN-SR -1)))
  (setq DN-SR (/ DN-SR 2))
  (setq ENAME (car (entsel "\nPolylinie wählen: ")))
  (while (and
           (/= (cdr (assoc 0 (entget ENAME))) "POLYLINE")
           (/= (cdr (assoc 0 (entget ENAME))) "LWPOLYLINE")
           ) ;_ end of and
    (alert "Das gewählte Objekt ist keine Polylinie !")
    (setq ENAME (car (entsel "\nPolylinie wählen:")))
    ) ;_ end of while
  (setq STARTPUNKT (getpoint "\nStart:"))
  (setq ENDPUNKT (getpoint "\rEnde :"))
  ;;  (setq AX-OBJ (vlax-ename->vla-object ENAME)) ;_ LISP-Objektname -> AX-Objekt
  ;; Stützpunkte des Objekts ermitteln
  (setq POINTS-LST (GET-COORDINATES ENAME)) ;_ end of setq
  ;; Format Koordintenliste ändern 
  (cond
    ((= (cdr (assoc 0 (entget ENAME))) "POLYLINE")
     ;; (1x 1y 1z 2x 2y 2z nx ny nz) -> ((1x 1y 1z)(2x 2y 2z)(nx ny nz))
     (setq POINTS-LST (VLAX-GET-COORDINATES-XYZ->COORDLIST POINTS-LST))
     )
    ((= (cdr (assoc 0 (entget ENAME))) "LWPOLYLINE")
     ;; (1x 1y 2x 2y nx ny) -> ((1x 1y 0.0)(2x 2y 0.0)(n xny 0.0))
     (setq POINTS-LST (VLAX-GET-COORDINATES-XY->COORDLIST POINTS-LST))
     )
    ) ;_ end of cond
  ;; Distanzen entsprechend StützpunktListe
  (setq POINTS-DISTANCES-LST (CALCULATE-DISTANCE ENAME POINTS-LST)) ;_ end of setq
  ;; Kombinieren der Distanzen mit den Koordinaten
  (setq
    DIST-POINTS-LST
     (mapcar
       (function (lambda (X Y) (list X Y)))
       POINTS-DISTANCES-LST
       POINTS-LST
       ) ;_ end of mapcar
    ) ;_ end of setq
  ;; Koordinatenliste entsprechend Punktliste
  (setq START-END-LST (GET-CLOSEST-4-LST ENAME (list STARTPUNKT ENDPUNKT)))
  ;; Distanzen für Start-Endpunkt-Liste
  (setq START-END-DISTANCES-LST (CALCULATE-DISTANCE ENAME START-END-LST))
  ;; Kombinieren der Distanzen mit den Koordinaten
  (setq
    DIST-START-END-POINT-LST
     (vl-sort
       (mapcar
         (function (lambda (X Y) (list X Y)))
         START-END-DISTANCES-LST
         START-END-LST
         ) ;_ end of mapcar
       (function (lambda (X Y) (< (car X) (car Y))))
       ) ;_ end of vl-sort
    ) ;_ end of setq
  ;; Jetzt kann man die Koordinaten über die Distanzen so kombinieren,
  ;; das als Resultat eine Koordinatenliste Vom Pickpunkt 1 bis Pickpunkt 2
  ;; mit allen dazwischenliegenden Stützpunkten entsteht. Mathematik ;-)
  (setq
    POINTS
     (vl-remove-if
       (function
         (lambda (X) (<= (car X) (car (nth 0 DIST-START-END-POINT-LST))))
         ) ;_ end of function
       DIST-POINTS-LST
       ) ;_ end of vl-remove-if
    ) ;_ end of setq
  (setq
    POINTS
     (vl-remove-if
       (function
         (lambda (X) (>= (car X) (car (nth 1 DIST-START-END-POINT-LST))))
         ) ;_ end of function
       POINTS
       ) ;_ end of vl-remove-if
    ) ;_ end of setq
  ;; Bis hier haben wir alle Punkte ermittelt, die ZWISCHEN den Pickpunkten liegen...
  ;; Voranstellen des einen Pickpunkts...
  (setq
    POINTS
     (cons (nth 0 DIST-START-END-POINT-LST) POINTS)
    ) ;_ end of setq
  ;; Anhängen des anderen Pickpunktes
  (setq
    POINTS
     (append POINTS (list (nth 1 DIST-START-END-POINT-LST)))
    ) ;_ end of setq
  ;; Jetzt noch die Distanzen aus der Liste schmeissen...
  (setq POINTS (mapcar (function (lambda (X) (cadr X))) POINTS))
  (DRAW-PL POINTS)
  ;; erzeugen einer Dummy-Teil-Polylinie = Achse Schutzrohr
  (setq DUMMY-PL (entlast))
  (setvar "OSMODE" 0)
;;; ---- Versetzen ------- wählen Sie hier wie Sie versetzen wollen-----------------------------

  ;; Variante 1
  ;; Versetzen der Teil-Polylinie Schutzrohrachse mit vla-offset
  ;; !!! Nicht vergessen beim Verwenden der Offset Method:
  ;; !!! Rückgabe ist ein ARRAY von Objekten, denn beim Versetzen von einem Objekt können unter Umständen
  ;; !!! mehrere Objekte entstehen (nicht nur eines).  (marc scherer cad.de)
  ;; (vla-offset (vlax-ename->vla-object(car(Entsel))) 10)
  ;; thomas krüger cad.de

;;;;;;;;;;;;;;;  (setq AX-OBJ (vlax-ename->vla-object DUMMY-PL)) ;_ LISP-Objektname -> AX-Objekt
;;;;;;;;;;;;;;;  (vla-offset AX-OBJ (* DN-SR -1))
;;;;;;;;;;;;;;;  (setq DUMMY-SR-LINKS (entlast))
;;;;;;;;;;;;;;;  ;; Versetzen der Teil-Polylinie Schutzrohr achse nach rechts
;;;;;;;;;;;;;;;  (vla-offset AX-OBJ DN-SR)
;;;;;;;;;;;;;;;  (setq DUMMY-SR-RECHTS (entlast))
;;;;;;;;;;;;;;;  (DUMMY_ERASE DUMMY-PL)

  ;; Variante 2
  ;; Versetzen der Teil-Polylinie Schutzrohrachse mit Command-Befehl _.offset
  ;; Dazu muss ein Seitenpunkt berechnet werden
  ;; (polar pkt1((if rechts - +)(angle pkt1 pkt2) (/ pi 2.0))10.0)
  ;; rechts ist dabei nil oder T, die Strecke von 10.0 ist willkürlich gesetzt.
  ;; joern bosse cad.de

  (setq
    SEITENPUNKT
     (polar
       (nth 0 POINTS) ; liest das erste Koordinatenpaar aus der Punktliste der TeilPL
       ((if RECHTS
          -
          +)
         (angle (nth 0 POINTS) (nth 1 POINTS))
         (/ pi 2.0))
       10 ; fiktiver Wert
       )
    )

  (command "_.offset" DN-SR DUMMY-PL SEITENPUNKT "")
  (setq DUMMY-SR-LINKS (entlast))
  (setq RECHTS t)
  (setq
    SEITENPUNKT
     (polar
       (nth 0 POINTS) ; liest das erste Koordinatenpaar aus der Punktliste der TeilPL
       ((if RECHTS
          -
          +)
         (angle (nth 0 POINTS) (nth 1 POINTS))
         (/ pi 2.0))
       10 ; fiktiver Wert
       ))
  (command "_.offset" DN-SR DUMMY-PL SEITENPUNKT "")
  (setq DUMMY-SR-RECHTS (entlast))
  (DUMMY_ERASE DUMMY-PL)

;;; ---Ende Versetzen----------------------------------------------------------------

  ;; Stützpunkte der nach links versetzten Polylinie lesen und Dummy löschen
  (setq POINTS-LST-LINKS (GET-COORDINATES DUMMY-SR-LINKS)) ;_ end of setq
  (setq POINTS-LST-LINKS (VLAX-GET-COORDINATES-XYZ->COORDLIST POINTS-LST-LINKS))
  (DUMMY_ERASE DUMMY-SR-LINKS)
  ;; Stützpunkte der nach rechts versetzten Polylinie lesen und Dummy löschen
  (setq POINTS-LST-RECHTS (GET-COORDINATES DUMMY-SR-RECHTS)) ;_ end of setq
  (setq POINTS-LST-RECHTS (VLAX-GET-COORDINATES-XYZ->COORDLIST POINTS-LST-RECHTS))
  (DUMMY_ERASE DUMMY-SR-RECHTS)

  ;; neue Koordinatenliste für kompletten Schutzrohrumring erzeugen und zeichnen der Polylinie
  (setq POINTS (append POINTS-LST-LINKS (reverse (cons (nth 0 POINTS-LST-LINKS) POINTS-LST-RECHTS))))
  (DRAW-PL POINTS)
  (SETVAR_OUT *SVIN)
  (princ)
  ) ;_ end of defun