Ich traue der Böschungsschraffur dee DACH nicht. Da kann es schon passieren,
dass man zB nur eine Layereinstellung der betreffenden Elementkannte ändert und sich die Schraffur dabei zerballert. Ich verwende seid eh und je ein Lisp-tool:
;;; BOESCH.LSP
;;;
;;; 10.11.1997 (c) Christoph Candido, Wien
;;; E-Mail: h8540418@edv1.boku.ac.at
;;;
;;; Boeschungssignaturen erstellen.
;;;
(defun C:BOESCH (/ *boesch_err* getent getd oerr oech obm en1 en2 d
ss ssneu ssd i en ent pt1 pt2 pt3 ang j)
(defun *boesch_err* (s) ; Fehlerroutine
(setq *error* oerr)
(if (and en1 (/= "" en1)) (redraw (car en1)))
(if (and en2 (/= "" en2)) (redraw (car en2)))
(command "_.UNDO" "_End")
(setvar "CMDECHO" oech)
(setvar "BLIPMODE" obm)
(princ)
)
(defun getent (txt / en)
(princ txt)
(initget " ")
(while (not (setq en (entsel "")))
(initget " ")
)
en
)
;; (getd <txt> )
;; erweiterte (getdist) Funktion
;;
(defun getd (txt / cont pt1 pt2 d)
(setq cont T)
(while cont
(initget 128)
(setq pt1 (getpoint txt))
(cond
( (null pt1) (setq cont nil))
( (= 'LIST (type pt1))
(setq pt2
(getpoint pt1 "\nZweiter Punkt (nach links = neg. Abstand): ")
)
(if pt2
(progn
(setq d (distance pt1 pt2))
(if (> (car pt1) (car pt2))
(setq d (- d))
)
(setq cont nil)
)
)
)
( (setq d (distof pt1))
(setq cont nil)
)
)
)
d
)
(setq oerr *error*
*error* *boesch_err*
oech (getvar "CMDECHO")
obm (getvar "BLIPMODE")
)
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
(setq en1 (getent "\nObere Grenzkante picken: "))
(if (/= "" en1)
(progn
(redraw (car en1) 3)
(setq en2 (getent "\nUntere Grenzkante picken: "))
(if (/= "" en2)
(progn
(redraw (car en2) 3)
(setq d (getd (strcat "\nSchraffurabstand (neg. Abstand wechselt "
"die Richtung): ")))
(if d
(progn
(if (= 0 (getvar "UNDOCTL")) (command "_.UNDO" "_All"))
(command "_.UNDO" "_End" "_.UNDO" "_Group")
;; Blockdefinition fuer temp. Linienbloecke erzeugen:
(entmake '((0 . "BLOCK")(2 . "BOESCH")(10 0.0 0.0 0.0)(70 . 0)))
(entmake
(list
'(0 . "LINE")
'(8 . "0")
'(10 0.0 0.0 0.0)
(if (minusp d)
'(11 0.0 0.0001 0.0)
'(11 0.0 -0.0001 0.0)
)
)
)
(entmake '((0 . "ENDBLK")))
;; temp. Linienbloecke einfuegen:
(command "_.MEASURE" en1 "_Block" "BOESCH" "_Y" (abs d))
(setq ss (ssget "_P")
ssneu (ssadd)
i 0
)
;; temp. Linienbloecke explodieren:
(while (setq en (ssname ss i))
(command "_.EXPLODE" en)
(setq en (entlast)
ssneu (ssadd en ssneu)
i (1+ i)
)
)
(setq i 0
j 1
ss (ssadd)
ssd (ssadd)
)
;; Linien dehnen und kuerzen:
(command "_.EXTEND" en2 "")
(while (setq en (ssname ssneu i))
(setq i (1+ i)
ent (entget en)
pt1 (cdr (assoc 10 ent))
pt2 (cdr (assoc 11 ent))
)
(command (list en (trans pt2 0 1)))
(if (equal pt2 (setq pt3 (cdr (assoc 11 (setq ent (entget en '("*")))))) 0.00001)
(ssadd en ssd)
(if (= j 1)
(progn
(ssadd en ss)
(setq j 0)
)
(setq j (1+ j))
)
)
)
(command)
(setq i 0)
(while (setq en (ssname ss i))
(setq ent (entget en)
pt1 (cdr (assoc 10 ent))
pt2 (cdr (assoc 11 ent))
d (/ (distance pt1 pt2) 2)
ang (angle pt1 pt2)
pt2 (polar pt1 ang d)
ent (subst (cons 11 pt2) (assoc 11 ent) ent)
i (1+ i)
)
(entmod ent)
)
(setq i 0)
(while (setq en (ssname ssd i))
(entdel en)
(setq i (1+ i))
)
;; Signaturen gruppieren (Rel.13/14)
(command "_.-GROUP" "_Create" "*" "Boeschung" ssneu "")
(command "_.UNDO" "_End")
)
)
)
)
)
)
(if (and en1 (/= "" en1)) (redraw (car en1) 4))
(if (and en2 (/= "" en2)) (redraw (car en2) 4))
(setvar "CMDECHO" oech)
(setvar "BLIPMODE" obm)
(setq *error* oerr)
(princ)
)
(princ "\n********************************")
(princ "\n(c)1997 Christoph Candido, Wien")
(princ "\nE-Mail: h8540418@edv1.boku.ac.at")
(princ "\n********************************")
(princ "\nBoeschungssignaturen generieren ")
(princ "\nAufruf: BOESCH ")
(princ)
Funzt auch im Standard-ACAD!
Gruß
CADso
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP