Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Lisp
  Nummern forlaufend

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:   Nummern forlaufend (910 mal gelesen)
Dober Heinz
Mitglied
Technischer Zeichner


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

Beiträge: 1106
Registriert: 20.12.2002

erstellt am: 20. Apr. 2005 12:44    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 Lispler
Habe eine Bitte kann mir jemand das Lisp so ändern, das ich dem Text am Fadenkreuz schon seh, damit ich ihn besser Platzieren kann.
Danke Heinz

(defun c:num (/ nr ipt ant th  prefix)
(setq LAY_OLD (getvar "CLAYER"))
(setq prefix (getstring "\nTextprefix: ")
        nr    (if (setq ant (getint "\nStartnummer <0>"))
                (1- ant)
                0
                ) ;_ end of if
        th    (getreal "\nTexthöhe:") )

 
(princ "\nWählen sie ein Element für die Layerschaltung : ")
(setq AWS (ssget))
(setq AWS (ssname AWS 0)) 
(setq LAY_NEW (cdr (assoc 8 (entget AWS))))
(setvar "CLAYER" LAY_NEW)

  (while
    (setq
      ipt (getpoint
            (strcat "\nEinfügepunkt: " (itoa (setq nr (1+ nr))) ":")
            ) ;_ end of getpoint
      ) ;_ end of setq

    (entmake
      (list
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        (cons 8 lay_new)
        '(100 . "AcDbText")
        (cons 10 ipt)
        (cons 40 th)
        (cons 1 (strcat prefix (itoa nr)))
        '(50 . 0.0)
        '(41 . 1.0)
        '(51 . 0.0)
        (cons 7 (getvar"textstyle"))
        '(71 . 0)
        '(72 . 0) ;1 ist gleich mitte Text 2 ist rechts der Text
        (cons 11 ipt)
        '(210 0.0 0.0 1.0)
        '(100 . "AcDbText")
        '(73 . 0) ; 1 ist gleich mitte Text
        ) ;_ end of list
      ) ;_ end of entmake
    ) ;_ end of while

(setvar "CLAYER" LAY_OLD)
  )

 

------------------
Heinz 

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

fca_mi2
Mitglied
Bauingenieur


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

Beiträge: 485
Registriert: 10.01.2003

ACAD2015

erstellt am: 20. Apr. 2005 13:57    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 Dober Heinz 10 Unities + Antwort hilfreich

häng' doch einfach einen "schieben" befehl an:

(command "schieben" "l" "" ipt pause)

------------------
MfG
Frank

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

Dober Heinz
Mitglied
Technischer Zeichner


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

Beiträge: 1106
Registriert: 20.12.2002

erstellt am: 20. Apr. 2005 14:06    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

Zitat:
Original erstellt von fca_mi2:
häng' doch einfach einen "schieben" befehl an:

(command "schieben" "l" "" ipt pause)


und wo füge ich das ein
Danke

------------------
Heinz 

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

Brischke
Moderator
CAD on demand GmbH




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

Beiträge: 4136
Registriert: 17.05.2001

AutoCAD 20XX, defun-tools (d-tools.eu)

erstellt am: 20. Apr. 2005 14:29    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 Dober Heinz 10 Unities + Antwort hilfreich

... vor der letzten schließenden Klammer

Grüße Holger

------------------
Holger Brischke
CAD on demand GmbH                              Autodesk User Group Central Europe
Individuelle Lösungen von Heute auf Morgen.              AUGCE Manager Deutschland

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

Dober Heinz
Mitglied
Technischer Zeichner


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

Beiträge: 1106
Registriert: 20.12.2002

erstellt am: 20. Apr. 2005 14:37    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
das sieht dan so aus funkt aber nicht
danke(defun c:num (/ nr ipt ant th  prefix)
(setq LAY_OLD (getvar "CLAYER"))
(setq prefix (getstring "\nTextprefix: ")
        nr    (if (setq ant (getint "\nStartnummer <0>"))
                (1- ant)
                0
                ) ;_ end of if
        th    (getreal "\nTexthöhe:") )

 
(princ "\nWählen sie ein Element für die Layerschaltung : ")
(setq AWS (ssget))
(setq AWS (ssname AWS 0)) 
(setq LAY_NEW (cdr (assoc 8 (entget AWS))))
(setvar "CLAYER" LAY_NEW)

  (while
    (setq
      ipt (getpoint
            (strcat "\nEinfügepunkt: " (itoa (setq nr (1+ nr))) ":")
            ) ;_ end of getpoint
      ) ;_ end of setq

    (entmake
      (list
        '(0 . "TEXT")
        '(100 . "AcDbEntity")
        '(67 . 0)
        '(410 . "Model")
        (cons 8 lay_new)
        '(100 . "AcDbText")
        (cons 10 ipt)
        (cons 40 th)
        (cons 1 (strcat prefix (itoa nr)))
        '(50 . 0.0)
        '(41 . 1.0)
        '(51 . 0.0)
        (cons 7 (getvar"textstyle"))
        '(71 . 0)
        '(72 . 0) ;1 ist gleich mitte Text 2 ist rechts der Text
        (cons 11 ipt)
        '(210 0.0 0.0 1.0)
        '(100 . "AcDbText")
        '(73 . 0) ; 1 ist gleich mitte Text
        ) ;_ end of list
      ) ;_ end of entmake
    ) ;_ end of while
(setvar "CLAYER" LAY_OLD)
(command "schieben" "I" ""ipt pause)
  )

------------------
Heinz 

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

tunnelbauer
Ehrenmitglied V.I.P. h.c.
Bauingenieur



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

Beiträge: 7085
Registriert: 13.01.2004

ich hab eh keine Probleme damit...

erstellt am: 20. Apr. 2005 14:41    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 Dober Heinz 10 Unities + Antwort hilfreich

Weil du nicht das selbe eingefügt hast wie dir Frank gepostet hat;

Markiere den Text von Frank und füge ihn mittels copy & paste (Kopieren  & Einfügen) ein (über deinen Text) dann klappt es auch.

------------------
Grüsse

Thomas

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

Dober Heinz
Mitglied
Technischer Zeichner


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

Beiträge: 1106
Registriert: 20.12.2002

erstellt am: 20. Apr. 2005 14:45    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

@ Tunnelbauer
Ja das habe ich gemacht funkt aber nicht
danke

------------------
Heinz 

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

CADwiesel
Moderator
CAD4FM UG




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

Beiträge: 1911
Registriert: 05.09.2000

AutoCAD, Bricscad
Wir machen das Mögliche unmöglich

erstellt am: 20. Apr. 2005 14:48    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 Dober Heinz 10 Unities + Antwort hilfreich

'n kleines Schmankerl von meinereiner

Code:

(defun c:num (/ PointByCrosshair TXTDRAW LAY_OLD prefix nr th AWS LAY_NEW ipt)
  (defun PointByCrosshair (color tx wi / P p0 p1 tt)
  (Setq p0 (getvar "extmin")
        p1 (getvar "extmax")
        ) ;_ end of Setq
  (if (< (length (cdr (setq P (grread 't 5 0)))) 3)
    (setq P (cons 3
                  (list (list (+ (/ (nth 0 p0) 2) (/ (nth 0 p1) 2))
                              (+ (/ (nth 1 p0) 2) (/ (nth 1 p1) 2))
                              (+ (/ (nth 2 p0) 2) (/ (nth 2 p1) 2))
                              ) ;_ end of list
                        ) ;_ end of list
                  ) ;_ end of cons
          ) ;_ end of setq
    ) ;_ end of if
  (setq tt (TXTDRAW (cadr P) color tx wi))
  (while (= 5 (car (setq P (grread 't 5 0))))
    (if tt
      (entdel tt)
      ) ;_ end of if
    (setq tt (TXTDRAW (cadr P) color tx wi))
    ) ;_ end of while
  (if tt
    (entdel tt)
    ) ;_ end of if
  (if (= 3 (car P))
    (cadr P)
    ) ;_ end of if
  ) ;_ end of defun

(defun TXTDRAW (PKT CLR TEXT win /)
  (entmake
    (list
      '(0 . "TEXT")
      (cons 8 CLR)
      (cons 10 PKT)
      (cons 40 win)
      (cons 1 TEXT)
      '(50 . 0.0)
      (cons 7 (getvar "textstyle"))
      '(71 . 0)
      '(72 . 0)
      ) ;_ end of list
    ) ;_ end of entmake
  (entlast)
  ) ;_ end of defun
  (setq LAY_OLD (getvar "CLAYER"))
  (setq prefix (getstring "\nTextprefix: ")
        nr    (if (setq nr(getint "\nStartnummer <0>"))
                nr
                0
                ) ;_ end of if
        th    (getreal "\nTexthöhe:")
        ) ;_ end of setq
  (princ "\nWählen sie ein Element für die Layerschaltung : ")
  (setq AWS (ssget))
  (setq AWS (ssname AWS 0))
  (setq LAY_NEW (cdr (assoc 8 (entget AWS))))
  (setvar "CLAYER" LAY_NEW)
  (while
    (setq
      ipt
      (PointByCrosshair lay_new (strcat prefix (itoa nr)) th)
      ) ;_ end of setq
    (TXTDRAW ipt LAY_NEW (strcat prefix (itoa nr)) th)
    (setq nr (1+ nr))
    ) ;_ end of while
  (setvar "CLAYER" LAY_OLD)
  ) ;_ end of defun


------------------
Gruß
CADwiesel
Besucht uns im CHAT

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

tunnelbauer
Ehrenmitglied V.I.P. h.c.
Bauingenieur



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

Beiträge: 7085
Registriert: 13.01.2004

ich hab eh keine Probleme damit...

erstellt am: 20. Apr. 2005 14:51    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 Dober Heinz 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von Dober Heinz:

(command "schieben" "I" ""ipt pause)

Zitat:
Original erstellt von fca_mi2:

(command "schieben" "l" "" ipt pause)

Achso ? Bei mir sieht es anders aus....

erstens:
Du haste ein grosses i eingefügt; Frank hat aber ein L vorgeschlagen und
zweitens:
hast du bei den Leerzeichen auch ein ziemliches durcheinander reingebracht...

Lisp ist eine Programmiersprache, die keine Fehler verzeiht !

------------------
Grüsse

Thomas

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

Dober Heinz
Mitglied
Technischer Zeichner


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

Beiträge: 1106
Registriert: 20.12.2002

erstellt am: 20. Apr. 2005 15:06    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

@ Cadwiesl
Danke super Lisp
10 us
danke heinz

------------------
Heinz 

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