;|  Prozent-Pack   (1.1)
CAD-Spiegel.jimdo.com
CAD-Spiegel@gmx.at
15.08.2010

Dieses Pack beinhaltet vier Befehle: %, %+, %#, prozent (pz).
Bei % wird die Steigung einer Linie in Prozent wiedergegeben.
Bei %+ wird nicht nur der Prozentwert wiedergegeben sondern ein Text mit dem Prozentwert eingefügt.
Bei %# gleich wie %+, nur das mehrere Linie ausgewählt werden können.
Bei prozent (pz) wird ein Block eingefügt der den Prozentwert wiedergibt.
|;
 ; Unterfunktion: cs_mp
(defun cs_mp (p1 p2)
  (setq	x (/ (+ (car p1) (car p2)) 2)
	y (/ (+ (cadr p1) (cadr p2)) 2)
  )
  (if (and (caddr p1) (caddr p2))
    (list x y (/ (+ (caddr p1) (caddr p2)) 2))
    (list x y)
  )
)
 ; Unterfunktion: cs_getobj
(defun cs_getobj (bit name text / obj flag)
  (setq flag T)
  (while flag
    (while (not (setq obj (entsel text))))
    (if	(= "*" bit)
      (setq obj (car obj))
      (if (member (cdr (assoc bit (entget (car obj)))) name)
	(progn
	  (setq obj (car obj))
	  (setq flag nil)
	)
      )
    )
  )
  (eval obj)
)
; Unterfunktion: cs_mapss
(defun cs_mapss	(funk ss / liste z)
  (setq	liste nil
	z -1
  )
  (repeat (sslength ss)
    (setq obj (ssname ss (setq z (1+ z))))
    (if	liste
      (setq liste (cons obj liste))
      (setq liste (list obj))
    )
  )
  (mapcar funk liste)
)
 ; Hauptfunktion: %
(defun C:% ()
  (setq	obj (cs_getobj 0 '("LINE") "\nLinie wählen: ")
	p1  (cdr (assoc 10 (entget obj)))
	p2  (cdr (assoc 11 (entget obj)))
  )
  (prompt (strcat "\n" (rtos (abs (* 100 (/ (- (cadr p1) (cadr p2)) (- (car p1) (car p2))))) 2 2) "%"))
  (princ)
)
; Hauptfunktion:  %+
(defun C:%+ ()
  (setq	obj (cs_getobj 0 '("LINE") "\nLinie wählen: ")
	p1  (cdr (assoc 10 (entget obj)))
	p2  (cdr (assoc 11 (entget obj)))
	win (vla-get-angle (vlax-ename->vla-object obj))
	pro (abs (* 100 (/ (- (cadr p1) (cadr p2)) (- (car p1) (car p2)))))
  )
  (if (<= 1.5708 win 4.70)
    (setq win (+ win pi))
  )
  (entmake (list '(0 . "TEXT")
		 (cons 1 (strcat (rtos pro 2 2) "%"))
		 (cons 7 (getvar "TEXTSTYLE"))
		 (cons 8 (getvar "clayer"))
		 (cons 10 (getpoint "\n Einfügepunkt angeben: "))
		 (cons 40 (getvar "TEXTSIZE"))
		 (cons 50 win)
	   )
  )
  (prompt (strcat "\n" (rtos pro 2 2) "%"))
  (princ)
)
 ; Hauptfunktion:  %#
(defun C:%# ()
  (cs_mapss
    '(lambda (obj)
       (setq p1	 (cdr (assoc 10 (entget obj)))
	     p2	 (cdr (assoc 11 (entget obj)))
	     win (vla-get-angle (vlax-ename->vla-object obj))
	     pro (abs (* 100 (/ (- (cadr p1) (cadr p2)) (- (car p1) (car p2)))))
       )
       (if (<= 1.5708 win 4.70)
	 (setq win (+ win pi))
       )
       (entmake	(list '(0 . "TEXT")
		      (cons 1 (strcat (rtos pro 2 2) "%"))
		      (cons 7 (getvar "TEXTSTYLE"))
		      (cons 8 (getvar "clayer"))
		      (cons 10 (cs_mp p1 p2))
		      (cons 40 (getvar "TEXTSIZE"))
		      (cons 50 win)
		)
       )
       (prompt (strcat "\n" (rtos pro 2 2) "%"))
       (princ)
     )
    (ssget '((0 . "LINE")))
  )
)
 ; Kurzbefehl:  pz
(defun C:pz ()
  (C:prozent)
)
 ; Hauptfunktion:  prozent
(defun C:prozent (/ obj p1 p2 areq pro)
  (setq	obj  (entget (cs_getobj 0 '("LINE") "\nLinie wählen: "))
	p1   (cdr (assoc 10 obj))
	p2   (cdr (assoc 11 obj))
	areq (getvar "ATTREQ")
  )
  (setvar "ATTREQ" 1)
  (if (> (car p1) (car p2))
    (setq p1 (cdr (assoc 11 obj))
	  p2 (cdr (assoc 10 obj))
    )
  )
  (setq	pro (abs (* (/ (- (cadr p1) (cadr p2)) (- (car p1) (car p2))) 100))
	dre (angtos (angle p1 p2) 2 5)
  )
  (setq pro (strcat (rtos pro 2 2) "%"))
  (command "_insert" "gefaelle.dwg" pause 1 1 dre pro)
  (setvar "ATTREQ" areq)
)