;---------------------------------------------------------------------------

;; SEV.LSP
;; Maakt een taludarcering tussen bestaande lijnen.
;;
;; ESF
;;

(defun myerror (e)
   (if (/= e "Function cancelled")
   (princ (strcat "\nError:" e))
   )
   (setvar "BLIPMODE" bm)
   (setvar "OSMODE" om)
   (setvar "EDGEMODE" em)
   (setq *error* olderr)
   (setvar "CMDECHO" 1)
   (princ)
)

(defun C:SEV (/ em om bm boven hafst sset1 sset2 cnt even ent ptx pt1 pt2)
   (setq olderr *error* *error* myerror)
   (setvar "CMDECHO" 0)
   (setq om (getvar "OSMODE"))
   (setvar "OSMODE" 0)
   (setq bm (getvar "BLIPMODE"))
   (setvar "BLIPMODE" 0)
   (setq em (getvar "EDGEMODE"))
   (setvar "EDGEMODE" 0)
   (setq cl (getvar "clayer"))

   (command "layer" "make" "Sev-kısa" "color" "7" "Sev-kısa" "")    ;;; toevoeging
   (command "layer" "make" "Sev-uzun" "color" "7" "sev-uzun" "")    ;;; toevoeging

   (if (null (tblsearch "BLOCK" "SEV"))
      (progn
         (command "layer" "set" "0" "")
         (entmake '((0 . "BLOCK") (2 . "SEV") (70 . 64) (10 0.0 0.0 0.0)))
         (entmake '((0 . "LINE") (8 . "Sev-uzun") (10 0.0 0.0 0.0) (11 0.0 0.1 0.0)))   ;;wijziging laagnaam
         (entmake '((0 . "ENDBLK")))
      )
   )
   (setq boven (entsel "\nSev Ustu: "))
   (redraw (car boven) 3)
       (princ "\nSev Altını Sec : ")
       (setq onder (ssget))
    (setq afst 2)
   (if (null afst)
      (setq afst (getdist "\nSev Ara Mesafesi  : "))
      (setq hafst (getdist (strcat "\nSev Ara Mesafesi <"
                (rtos afst 2 2) ">: ")))
   )
   (if hafst (setq afst hafst))
   (redraw (car boven) 4)
   (command "layer" "set" "Sev-uzun" "")
   (command "MEASURE" boven "BLOCK" "SEV" "Y" afst)
   (setq sset1 (ssget "X" '((2 . "SEV"))))
   (setq cnt 0)
   (setq even T)
   (repeat (sslength sset1)
      (setq ent (ssname sset1 cnt))
      (setq ptx (cdr (assoc 10 (entget ent))))
      (command "EXPLODE" ent)
      (command "chprop" "P" "" "layer" "Sev-uzun" "")   ;;;toevoeging
      (setq sset2 (ssget "P")
            ent (ssname sset2 0)
            pt1 (cdr (assoc 10 (entget ent)))
            pt2 (cdr (assoc 11 (entget ent)))
            an (angle pt1 pt2)
            pt1 (list ent (polar pt1 an 0.01))
            pt2 (list ent (polar pt2 (+ an pi) 0.01))
      )
      (command "EXTEND" onder "" pt1 pt2 "")
      (command "TRIM" boven "" pt1 "")
      (if (< (distance (cdr (assoc 10 (entget ent)))
          (cdr (assoc 11 (entget ent)))) 0.01)
          (progn
     (command "ERASE" ent "")
     (setq even nil)
  )
      )
      (if (= even T)
         (progn
    (command "SCALE" ent "" ptx 0.5)
            (command "chprop" ent "" "layer" "Sev-kısa" "")   ;;;toevoeging
    (setq even nil)
)
(setq even T)
      )
      (setq cnt (1+ cnt))
   )
   (setvar "OSMODE" om)
   (setvar "BLIPMODE" bm)
   (setvar "EDGEMODE" em)
   (setq *error* olderr)
   (command "layer" "set" cl "")
   (setvar "CMDECHO" 1)
   (princ)
)
(princ "\nC:SEV geladen, typ SEV om te activeren. ")
(princ)
(princ)