; *******************************************************************************************************************************************
;																		++++++++++++++++++++++++	Hauptprogramm	++++++++++++++++++++++++
; *******************************************************************************************************************************************

(defun c:tgwork (/)
	(vl-load-com) 
	;(setvar "cmdecho" 0)	
	(setvar "clayer" "0")
	
	(alert "\nDieser Vorgang kann nun eine Weile dauern!!\nAutoCAD wird in dieser Zeit nicht auf Eingaben reagieren!!")

;	(sssetfirst nil (ssget "X" '((0 . "INSERT")(2 . "0118,0117"))))
		
; *******************************************************************************************************************************************
;																		++++++++++++++++++++++++	Hauptgruppen	++++++++++++++++++++++++
; *******************************************************************************************************************************************

; *******************************************************************************************************************************************
	
	(command ".-Layer" "_off" "1023_Geb\U+00E4udeschraffur" "_off" "1022_Geb\U+00E4ude+Hausnummer" "_off" "2803_Hinweislinien" "_off" "1019_Vermessungspunkte+Text" "")
	
	; #01
	(Prompt "\nStart: #01 Grenzzeichen")
	(setq ss (ssget "X" '((0 . "INSERT")(2 . "0118*,0117*")(41 . 0.375))))
	(cond (ss
	(grenzzeichen ss "KAT04" "1019_Vermessungspunkte+Text"))(t (Prompt "     ...#01 Grenzzeichen nicht gewechselt")))
	(setq ss nil)(setq ss nil)
	
	(Prompt "\nStart: #01a Grenzzeichen")
	(setq ss (ssget "X" '((0 . "INSERT")(2 . "0118*,0117*")(41 . 0.25))))
	(cond (ss
	(grenzzeichen ss "KAT04" "1019_Vermessungspunkte+Text"))(t (Prompt "     ...#01a Grenzzeichen nicht gewechselt")))
	(setq ss nil)(setq ss nil)
			
	(command ".-Layer" "_on" "*" "")
	
	(prompt "\n")
	(command "_regenall" "")

(Prompt "\nAufgaben erfolgreich beendet!")
(princ)
)

; *******************************************************************************************************************************************
;																	++++++++++++++++++++++++	Ende Hauptprogramm	++++++++++++++++++++++++
; *******************************************************************************************************************************************

; *******************************************************************************************************************************************
;																													grenzzeichen
(defun grenzzeichen (auswahl block layer)
	(Prompt "\n...Ersetze Grenzzeichen...")
	(setq count 0)
	(repeat (sslength auswahl)
		(setq temp (ssname auswahl count))
		(setq daten (entget temp))
		(setq liste (ssadd)) ; leere neue Auswahlliste
		(setq objekt(entmake(list '(0 . "CIRCLE")(cons 8 "0")(assoc 10 daten)(cons 40 0.675) )))
			(ssadd (entlast) liste) ; add zur neuen Liste
			(cond (liste (mextrim liste)))
		(setq del (entlast))
		(entdel del)
		(entdel temp)
		;;;;; Block einfügen
		(entmake
			(list
			'(0 . "INSERT")
			(cons 2 block)
			(cons 8 layer)
			(assoc 10 daten)
			'(41 . 1.0); X scale
			'(42 . 1.0); Y
			'(43 . 1.0); Z
			); list
		)
		(setq count (1+ count))
	)
	;;;;; evtl übrige (doppelte) Kreise entfernen
	(setq ss (ssget "X" '((0 . "CIRCLE")(40 . 0.675))))
	(cond (ss
	(command "_erase" ss "")))
	(setq ss nil)
	(setq liste nil)
	(Prompt "     ...Fertig")
)

; *******************************************************************************************************************************************
;																													MExTrim
(defun MExTrim (auswahl / rnd GroupByNum ptonline ptinsideent highlight 
                     ss n en ed enA minpt maxpt dx dy pt dxx dyy ) 
                     
  (vl-load-com)

  (load "extrim.lsp")

  (defun rnd (/ modulus multiplier increment rand)
    (if (not seed)
      (setq seed (getvar "DATE"))
    )
    (setq modulus    65536
          multiplier 25173
          increment  13849
          seed  (rem (+ (* multiplier seed) increment) modulus)
          rand     (/ seed modulus)
    )
  )

  (defun GroupByNum ( l n / f )
    (defun f ( a b )
      (if (and a (< 0 b))
        (cons (car a) (f (setq l (cdr a)) (1- b)))
      )
    )
    (if l (cons (f l n) (GroupByNum l n)))
  )

  (defun ptonline ( pt pt1 pt2 / vec12 vec1p d result )
    (setq vec12 (mapcar '- pt2 pt1))
    (setq vec12 (reverse (cdr (reverse vec12))))
    (setq vec1p (mapcar '- pt pt1))
    (setq vec1p (reverse (cdr (reverse vec1p))))
    (setq vec2p (mapcar '- pt2 pt))
    (setq vec2p (reverse (cdr (reverse vec2p))))
    (setq d (distance '(0.0 0.0) vec12) d1 (distance '(0.0 0.0) vec1p) d2 (distance '(0.0 0.0) vec2p))
    (if (equal d (+ d1 d2) 1e-8) (setq result T) (setq result nil))
    result
  )

  (defun ptinsideent ( pt ent / msp ptt xlin int k kk tst result )
    (vl-load-com)
    (setq msp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
    (setq ptt (vlax-curve-getclosestpointto ent pt))
    (setq xlin (vla-addxline msp (vlax-3d-point pt) (vlax-3d-point ptt)))
    (setq int (GroupByNum (vlax-invoke (if (eq (type ent) 'ENAME) (vlax-ename->vla-object ent)) 'intersectwith xlin acExtendBoth) 3))
    (setq int (vl-sort int '(lambda (a b) (< (vlax-curve-getparamatpoint xlin a) (vlax-curve-getparamatpoint xlin b)))))
    (setq k 0)
    (while (< (setq k (1+ k)) (length int))
      (if (and (eq (rem k 2) 1) (ptonline pt (nth (- k 1) int) (nth k int))) (setq tst (cons T tst)) (setq tst (cons nil tst)))
    )
    (setq tst (reverse tst))
    (setq k 0)
    (mapcar '(lambda (x) (setq k (1+ k)) (if (eq x T) (setq kk k))) tst)
    (vla-delete xlin)
    (if kk
      (if (eq (rem kk 2) 1) (setq result T) (setq result nil))
      (setq result nil)
    )
    result
  )

  (setq highlight (getvar "HighLight"))
  (acet-error-init (list
                     (list   "cmdecho" 0
                           "highlight" highlight
                           "regenmode" 1
                              "osmode" 0
                             "ucsicon" 0
                          "offsetdist" 0
                              "attreq" 0
                            "plinewid" 0
                           "plinetype" 1
                            "gridmode" 0
                             "celtype" "CONTINUOUS"
                           "ucsfollow" 0
                            "limcheck" 0
                     )
                     T     ;flag. True means use undo for error clean up.
                     '(if redraw_it (redraw na 4))
                    );list
  );acet-error-init

  ;;;;; EDIT
  ;(prompt "\nSelect closed entities: ")
  (if (setq ss auswahl)
  ;(if (setq ss (ssget (append (list '(-4 . "<or") '(0 . "CIRCLE") '(-4 . "<and") '(0 . "*POLYLINE") '(-4 . "<not") '(-4 . "&=") '(70 . 8) '(-4 . "not>") '(-4 . "&=") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "SPLINE") '(-4 . "&=") '(70 . 1) '(-4 . "and>") '(-4 . "<and") '(0 . "ELLIPSE") '(41 . 0.0)) (list (cons 42 (* 2 pi))) (list '(-4 . "and>") '(-4 . "or>")))))
  ;;;;; EDIT
  (progn
      (setq n (sslength ss))
      (while (>= (setq n (1- n)) 0)
        (setq en (ssname ss n) ed (entget en) enA (vlax-ename->vla-object en))
          (vla-getboundingbox enA 'minpoint 'maxpoint)
        (setq
         minpt (vlax-safearray->list minpoint)
         maxpt (vlax-safearray->list maxpoint)
        )
        (setq dx (- (car maxpt) (car minpt)))
        (setq dy (- (cadr maxpt) (cadr minpt)))
        (setq pt '(0.0 0.0 0.0))
        (while (not (ptinsideent pt en))
          (setq dxx (* dx (rnd)))
          (setq dyy (* dy (rnd)))
          (setq pt (list (+ (car minpt) dxx) (+ (cadr minpt) dyy) 0.0))
        )
        (etrim en pt)
      )
    )
  )
  (acet-error-restore)
  (princ)
)