Hallo,
leider bin ich kein Lispler.
Kann mir jemand vo Euch helfen?
Ich möchte, dass er die lisp auf dem aktuellen Layer ausführt und nicht auf Layer 0
wäre wirklich schön
;; 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)
------------------
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
