;;; Originale Quelle: https://ww3.cad.de/foren/ubb/Forum145/HTML/002643.shtml
;;; überarbeitet von Udo Hübner am 28.8.20 um die Versatzrichtung zu steuern
;;; Blechstärke positiv = Versatz nach Links,bei negativer Blechstärke Versatz nach links
;;; sowie eine Layer voreinzustellen


(defun c:UHblech (/ pt spt plineobj1 plineobj2 tmp cl ce)

;;;; Vorbelegungen  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (setq *Blech:layer* "Blech")                      ; Vorgabe Blechlayer
  (if (not *blech:Dicke*) (setq *blech:Dicke* 2.0)) ; vorgabbe Blechstärke

  ; Schraffureinstellungen direkt Zeile 96 = command "_Hatch"

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (setq cl (getvar "CLAYER"))
  (setq ce (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)

  ; wenn Layer nicht vorhanden, dann anlegen, sonst nur tauen und aktuell setzen.
  (if (not (tblsearch "LAYER" *Blech:layer*))
    (command "_Layer" "_Make" *Blech:layer* "")
    ; else
    (command "_Layer" "_Thaw" *Blech:layer* "_unlock" *Blech:layer* "_Set" *Blech:layer* "")
  )    
  
  (setq *blech:Dicke* (getrealnot0 "Blech-Dicke in mm: " *blech:Dicke*)
        spt          (getpoint "\nVon Punkt: ")
        pt            spt
  )
  ;; Radius setzen
  (setvar "FILLETRAD" (* 1.5 (abs *blech:Dicke*)))
  ;; Punkte abfragen und Pline zeichnen
  (while (and pt (setq pt (getpoint pt "\nnach Punkt: ")))
    ;; Wenn Pline vorhanden...
    (if plineobj1
      ;; -> dann Vertex hinzufügen + Offset
      (progn (vla-addvertex plineobj1
                            (1+ (vlax-curve-getendparam plineobj1))
                            (vlax*point->variant (2dpoint pt))
            )
            ;; verrrundn
            (command "_FILLET" "_P" (vlax-vla-object->ename plineobj1))
            ;; erst alten Offset löschen
            (if plineobj2
              (vla-delete plineobj2)
            )
            ;; dann neuen Offset erstellen
            (setq plineobj2
                    (car
                      (vlax-safearray->list
                        (variant-value (vla-offset plineobj1 (- *blech:Dicke*)))
                      )
                    )
            )
      )
      ;; -> sonst neue Pline erstellen + Offset
      (setq plineobj1 (vla-addlightweightpolyline
                        (vla-get-modelspace
                          (vla-get-activedocument (vlax-get-acad-object))
                        )
                        (vlax*pointlist2d->variant
                          (list (2dpoint spt) (2dpoint pt))
                        )
                      )
            plineobj2 (car (vlax-safearray->list
                            (variant-value (vla-offset plineobj1 (- *blech:Dicke*)))
                          )
                      )
      )
    )
  )
  ;; and Funktion bricht Evaluierung ab, wenn ein Argument nil (if nicht erforderlich !)
  (and plineobj1
      plineobj2
      ;; schließen mit Pedit (beide Plines mit großem Fuzzyabstand verbinden)
      (progn
       (command "_PEDIT"
                "_M" ; mehrere Objekte
                (vlax-vla-object->ename plineobj1)
                (vlax-vla-object->ename plineobj2)
                "" ; Ende Objektwahl
                "_J" ; Verbinden
                "_J" ; Verbindungstyp
                "_A" ; Hinzufügen
                (1+ (abs *blech:Dicke*)) ; Fuzzy (+1 zur Sicherheit)
                "_X" ; Exit
       )
       (command "_hatch" "ANSI31" (* 0.2 (abs *blech:Dicke*)) 0.0 "_last" "") ; Schraffur
      )
  )
  (setvar "CLAYER" cl)
  (setvar "CMDECHO" ce)

  (princ)
)
;;;--------------------------------
;;; GETREALnot0 - getreal ohne Null
;;; Anfragetext,Vorgabe (Zahl)
;;;--------------------------------
(defun getrealnot0 (anfrage vorgabe)
  (initget 2)
  (cond ((getreal (strcat "\n"
                          anfrage
                          " <"
                          (if (numberp vorgabe)
                            (rtos vorgabe 2 (getvar "LUPREC"))
                            ""
                          )
                          ">: "
                  )
        )
        )
        (t (float vorgabe))
  )
)
;;;---------------------------------
;;; Wandelt 2D-Punktliste in Variant um
;;;---------------------------------
(defun vlax*pointlist2d->variant (ptlist / arrayspace sarray)
  (setq arrayspace (vlax-make-safearray vlax-vbdouble
                                        (cons 0 (- (* 2 (length ptlist)) 1))
                  )
  )
  (setq sarray (vlax-safearray-fill arrayspace (apply 'append ptlist)))
  (vlax-make-variant sarray)
)
;;;---------------------------------
;;; Wandelt Punkt in Variant um
;;;---------------------------------
(defun vlax*point->variant (pt / arrayspace sarray)
  (setq
    arrayspace (vlax-make-safearray vlax-vbdouble (cons 0 (- (length pt) 1)))
  )
  (setq sarray (vlax-safearray-fill arrayspace pt))
  (vlax-make-variant sarray)
)
;;;---------------------------------
;;; Punkt in 2D-Punkt wandeln
;;;---------------------------------
(defun 2dpoint (point) (list (car point) (cadr point)))

(Defun C:UHSL()
  (Prompt "Schraffiere letztes Objekt:")
  ;(setvar "HPNAME" "ANSI31") ; Mustername
  ;(setvar "HPSCALE" 0.5)     ; Skalierfaktor
  ;(setvar "HPANG"   0.0)     ; Winkel

  ;(command "_hatch" "ANSI31" 0.5 0.0 "_last" "")
    (command "_hatch" "" "" "" "_last" "")
)
(Prompt "UHBLECH geladen, Start mit UHBLECH.")
(Print)