Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Layer in vorh. Lisp ändern

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   Layer in vorh. Lisp ändern (841 mal gelesen)
AsSchu
Ehrenmitglied
Konstrukteur


Sehen Sie sich das Profil von AsSchu an!   Senden Sie eine Private Message an AsSchu  Schreiben Sie einen Gästebucheintrag für AsSchu

Beiträge: 1632
Registriert: 27.06.2003

ACAD 2007,cadMANdu
Win 2000 XP

erstellt am: 17. Sep. 2003 09:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

Erwin Fortelny
Mitglied
Tech. Zeichner


Sehen Sie sich das Profil von Erwin Fortelny an!   Senden Sie eine Private Message an Erwin Fortelny  Schreiben Sie einen Gästebucheintrag für Erwin Fortelny

Beiträge: 871
Registriert: 13.12.2001

erstellt am: 17. Sep. 2003 09:24    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für AsSchu 10 Unities + Antwort hilfreich

Hallo!

Zitat:
Original erstellt von AsSchu:
leider bin ich kein Lispler.
Kann mir jemand vo Euch helfen?


Mal sehen ... 

Zitat:
Original erstellt von AsSchu:
Ich möchte, dass er die lisp auf dem aktuellen Layer ausführt und nicht auf Layer 0
wäre wirklich schön


OK ...

Ich versuche es nur mit Teilausschnitten, ich hoffe es genügt!?

Die relevante Stelle ist dies (Bei ';;***'):

Code:

;; 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")))

Das (8 . "0") bewirkt eben, dass als Layer der "0"er verwendet wird, falls Du den aktuellen verwenden willst, muß der Ausschnitt so aussehen:

Code:

;; Blockdefinition fuer temp. Linienbloecke erzeugen:
(setq clayer (getvar "CLAYER")) ;;***
(entmake '((0 . "BLOCK")(2 . "BOESCH")(10 0.0 0.0 0.0)(70 . 0)))
  (entmake
    (list
      '(0 . "LINE")
      '(8 . clayer) ;;***
      '(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")))


------------------
Servus, Erwin
--
foe@gmx.at

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

AsSchu
Ehrenmitglied
Konstrukteur


Sehen Sie sich das Profil von AsSchu an!   Senden Sie eine Private Message an AsSchu  Schreiben Sie einen Gästebucheintrag für AsSchu

Beiträge: 1632
Registriert: 27.06.2003

ACAD 2007,cadMANdu
Win 2000 XP

erstellt am: 17. Sep. 2003 09:35    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Daaaaanke, du bist ein Schatz
Deine u' kommen promt

Ciao

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

AsSchu
Ehrenmitglied
Konstrukteur


Sehen Sie sich das Profil von AsSchu an!   Senden Sie eine Private Message an AsSchu  Schreiben Sie einen Gästebucheintrag für AsSchu

Beiträge: 1632
Registriert: 27.06.2003

ACAD 2007,cadMANdu
Win 2000 XP

erstellt am: 17. Sep. 2003 10:04    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,
da habe ich dich zu früh gelobt.
Das klappt nicht.
Kommt folgende Meldung

Obere Grenzkante picken:
Untere Grenzkante picken:
Schraffurabstand (neg. Abstand wechselt die Richtung): 1
Kann Blockdefinitionen nicht verschachteln.

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

mapcar
Mitglied
CADmin



Sehen Sie sich das Profil von mapcar an!   Senden Sie eine Private Message an mapcar  Schreiben Sie einen Gästebucheintrag für mapcar

Beiträge: 1250
Registriert: 20.05.2002

Time flies like an arrow, fruit flies like a banana (Groucho Marx)

erstellt am: 17. Sep. 2003 10:26    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für AsSchu 10 Unities + Antwort hilfreich

So geht's nicht. Wenn schon, muss die betreffende Zeile durch
Code:
(cons 8(getvar"clayer"))
ersetzt werden. Aber viel einfacher ist es, wenn man diese Zeile einfach weglässt, dann landet das Ganze nämlich auch auf dem aktuellen Layer.

Gruss, Axel

------------------

Meine AutoLisp-Seiten
Meine private Homepage
Mein Angriff auf dein Zwerchfell
Mein Lexikon der Fotografie
Mein gereimtes Gesülze
Meine Überzeugung...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

AsSchu
Ehrenmitglied
Konstrukteur


Sehen Sie sich das Profil von AsSchu an!   Senden Sie eine Private Message an AsSchu  Schreiben Sie einen Gästebucheintrag für AsSchu

Beiträge: 1632
Registriert: 27.06.2003

ACAD 2007,cadMANdu
Win 2000 XP

erstellt am: 17. Sep. 2003 10:34    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hi Mapcar,
das habe ich eben auch herausbekommen.
So klappt das auch bei mir.


              ;; Blockdefinition fuer temp. Linienbloecke erzeugen:
(setq clayer (getvar "CLAYER")) ;
              (entmake '((0 . "BLOCK")(2 . "BOESCH")(10 0.0 0.0 0.0)(70 . 0)))
              (entmake
                (list
                  '(0 . "LINE")         
                  '(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")))

(setq clayer (getvar "CLAYER")) ;die kann man aber auch weglassen

Ciao

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Erwin Fortelny
Mitglied
Tech. Zeichner


Sehen Sie sich das Profil von Erwin Fortelny an!   Senden Sie eine Private Message an Erwin Fortelny  Schreiben Sie einen Gästebucheintrag für Erwin Fortelny

Beiträge: 871
Registriert: 13.12.2001

erstellt am: 18. Sep. 2003 08:00    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für AsSchu 10 Unities + Antwort hilfreich

Hallo AsSchu!

Sorry, der "Umbau" war rein aus den Kopf heraus ohne es zu probieren ... natürlich hat mapcar recht, mit "(cons 8 (getvar "clayer")) geht's noch einfacher oder man läßt es eben gleich ganz weg, und natürlich braucht man dann die "(setq ..." Zeile auch nicht mehr!

------------------
Servus, Erwin
--
foe@gmx.at

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz