---

hallo,

bin auf der suche nach einem tool zur erstellung von bezeichnungsnummern 1, 2, usw die nummern müßten aber in einem kreis stehen und natürlich eine hinweislinie haben.

mfg
Zec

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

---

Hi Zec,

herzlich willkommen auf cad.de/augce.de !

Zu deiner Frage:

Suche mal mit der Forumssuche nach einen Lisp Tool namens Nummer - da hat es dann auch die Erweiterungen mit Kreis gegeben - und ich bilde mir ein, dass der Ansatz mit der Hinweislinie auch andiskutiert wurde.

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

Thomas

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

---

1. Willkommen im Forum
2. Das , was du suchst, (und noch einiges mehr) kann Autocad-Mechanical ganz prima
3. Wo hast du denn schon gesucht? www.google.de  ist ein prima Helfer.
Einschlägige Seiten sind auch:
CADwiesel
cad-od
caddepot
cadalyst
cadresource
um nur mal einige zu nennen

------------------
  - Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

[Diese Nachricht wurde von CADmium am 28. Sep. 2005 editiert.]

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

---

Hallo Zec,

auf meiner Seite findest Du dazu auch was, eine Variante mit Text, die andere mit einem beliebigen Block !

Gruß, Jürgen

-------www.pc-ideal.de

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

---

Aus gibt aus der Autocad 10 (glaub ich) Zeit ein Tool, dass BALLON heißt, das deinem Wunsch entspricht.

VG
Wolfgang

------------------
LISP = Lots of Insane Stupid Parantheses

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

---

Bubba_auto.lsp.txt

Habe hier mal ein altes Tool etwas weiterbearbeitet. Mit den Größenfaktoren etc. ists aber etwas umständlich und sicher noch weiter zu verbessern. Da ich es aber selten benutze, habe ich es noch nicht getan. Vielleicht kannst du ja was damit anfangen.

------------------
Gruß
SebZ

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

---

Hallo Thomas,

hab was gefunden, klappt aber nicht so ganz, die bezeichnungslinie endet nich am kreis, schau es dir mal an

mfg
ZEC

(defun C:POS_NUM (/ NUM P1 P2 DXX DX DYY DY)

(defun NEUERR (MSG) (R_VAR) (princ MSG) (princ))

(setq ALTERR  *ERROR*
      *ERROR* NEUERR
      C_E    (getvar "CMDECHO")      ; ECHO
      C_L    (getvar "CLAYER")        ; LAYER
      P_M    (getvar "PDMODE")        ; Punktmuster
      P_S    (getvar "PDSIZE")        ; Punktgroesse
)

(setvar "CMDECHO" 0)
(setvar "ATTDIA" 0)
(if (not (tblsearch "LAYER" "2"))
  (command "LAYER" "MACH" "2" "FA" "2" "" "") ; Layer und Farbe
)
(setq NUM NIL)

(defun R_VAR ()
  (setq *ERROR* ALTERR)
  (setvar "PDMODE" P_M)
  (setvar "PDSIZE" P_S)
  (command "LAYER" "SE" C_L "" "REGEN")
  (setvar "CMDECHO" C_E)
  (setq NUM NIL)
)
;;-------------------------------------
(setq NUM 1
      WEITER t
)
(while WEITER
  (prompt "\n. \n. \n")
  (princ "\n \nBauteilnummer oder 0 für Ende 0/<") ; anzeigen
  (princ NUM)                          ; Vorgabenummer
  (setq TEMP (getint ">: "))            ; abfragen
  (if (= TEMP 0)
  (setq WEITER NIL)
  (progn
    (if TEMP
    (setq NUM TEMP)
    )                                  ; wenn nicht return
    (setq P1
          (getpoint "\n. \n. \nReturn für Exit/Startpunkt der Linie anklicken: "
          )
    )
    (if P1
    (progn
      (initget 1)
      (setq P2 (getpoint "\n. \n. \nEndpunkt der Linie anklicken: "))
      (initget "J N")
      (setq PU
            (getkword "\n: \n. \n. \nPunkt am Anfang der Linie setzen? N/<J>: "
            )
      )
      (if (not (= PU "N"))
      ;; Layer, Punktsymbol und -Durchmesser setzen
      (command "LAYER" "SE" "0" "" "PDMODE" "33" "PDSIZE" "0.4" ".PUNKT" P1)
      )
      (command "LAYER" "SE" "2" "" "_LINE" P1 P2 "")
    ) ;_ end progn
    (progn
      (setq WEITER NIL
            P2 NIL
      )
    )
    ) ;_ end if p1

    (if P2
    (progn
      (setq DXX (- (car P2) (car P1))
            DX  (- (car P1) (car P2))
            DYY (- (cadr P2) (cadr P1))
            DY  (- (cadr P1) (cadr P2))
      )
      (if (and (> DYY DXX) (> DXX DY) (> DYY DX)) ; Linie von oben
      (setq P (list (car P2) (+ (cadr P2) 4)))
      )
      (if (and (> DY DYY) (> DY DX))    ; ... unten
      (setq P (list (car P2) (- (cadr P2) 9)))
      )
      (if (and (> DXX DX) (> DXX DYY) (> DYY DX)) ; ... links
      (setq P (list (+ (car P2) 6) (- (cadr P2) 2)))
      )
      (if (and (> DX DYY) (> DX DY) (or (> DYY DY) (> DY DYY))) ; rechts
      (setq P (list (- (car P2) 6) (- (cadr P2) 2)))
      )
      (command "_CIRCLE" P "9" "TEXT" "P" "MI" P "5" "0" (itoa NUM))
    ) ;_end progn
    ) ;_end if
    (setq NUM (1+ NUM))
  )
  )
) ;_ end while weiter
(R_VAR)
(princ)
)                                      ; end defun c:...
(princ)

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

---

Hallo SebZ

funktioniert super, noch eine frage wie kann ich den Textstil
ändern

mfg
ZEC

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

---

Zitat:

---

Original erstellt von Zec:

wie kann ich den Textstil
ändern

---

indem du Anfangs z.B. ein
(setvar "TEXTSTYLE" "STANDARD")
einfügst

------------------
- Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

Hallo Zec,

das Tool funktioniert mit dem aktuellen Textstil. Ich habe mir zum Einrichten meiner meistgenutzten Stile ein paar Buttons eingerichtet, die nach folgendem Muster funktionieren:

^C^C_-style arial;arial.ttf;0;1;0;N;N

Tooltip-Beschriftung Hilfetext und Icon kannst du dir ja nach Belieben selbst ausdenken.
(Anmerkung: Wie Buttons in Werkzeugkästen unter AC2006 einzurichten sind, kann ich derzeit noch nicht sagen)

Wenn du Wert darauf legst, dass der Textstil im Lisp eingestellt wird, dann siehe CADmium, bzw.
  (command "_-style" "arial"    "arial.ttf" 0 1    0 "_N" "_N")
am Anfang einfügen. Mit disem Befehl wird der Textstil initialisiert, auch wenn er vorher noch nicht in der Zeichnung vereinbart war.

------------------
Gruß
SebZ

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

---

Hallo SebZ,

danke funktioniert super, nur da wäre ein problem mit den nummer,
und zwar kann ich die startnummer nicht eingeben.
ist dies rein lisp-technisch möglich.

mfg
ZEC

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

---

ersetze
(setq NUM 1
      WEITER t
)
z.B. durch
(setq weiter 'T)
(or(setq NUM (getint "\nStartnummer:<1> "))
  (setq NUM 1)
)

------------------
- Thomas -
"Bei 99% aller Probleme ist die umfassende Beschreibung des Problems bereits mehr als die Hälfte der Lösung desselben."

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

---

hallo SebZ,

mein programm:

;BUBBA.LSP
;This will insert an item callout to the proper scale using dimscale.
;on the DIM layer with the text green FOR RELEASE 13 and 14 ONLY.
;
;Written by: S. Restmeyer  12/28/95
;
;  Anmerkung:  Grüne Textfarbe und Layer "DIM" sind außer Funktion!
;              (31.10.2002 / Zichy)
;  Erweiterung: (31.10.2002 / Zichy)
;              Die Ballons werden mit Nummern gefüllt, die automatisch
;              um jeweils 1 erhöht werden und in der Benutzervariablen
;              USERI5 abgelegt werden. Umbenennung der Funktion auf
;              "Autonote".
;              19.11.2004: Kommandos internationalisiert; Prompts auf deutsch
;
;;;---------------------Begrüßung (Autor: Sebastian Zichy)---------
(princ "\nBUBBA_AUTO.LSP geladen.")
(princ "\nZeichnet Führungslinien mit automatisch erhöhten Nummern.")
(princ "\nVerwendet die Systemvariablen USERI5 (aktuelle Nr.), ")
(princ "USERR1 (Durchmesser), USERR2 (Texthöhe)")
(princ "\nAufruf mit \"AUTONOTE\"")
;
;;;----------------------ERROR FUNCTION----------------------------
;;;
(DEFUN ERR (S)
  ;if an error (such as CTRL-C) occurs while this command is active...
  (if (not (member s '("console break" "Function cancelled")))
      (princ (strcat "\nError: " s))
  )
  (command "_.UNDO" "_E")    ;end any outstanding UNDO group
  (setvar "cmdecho" cmd)      ;restore saved mode
  (setvar "orthomode" om)
  (setvar "highlight" hl)
  (setvar "textsize" ts)
  (setvar "aperture" as)
  (setvar "osmode" osm)
  (setvar "snapunit" su)
  (setvar "snapmode" sm)
  (setvar "pickbox" pb)
;  (setvar "clayer" lr)
  (setvar "dimtxt" dt)
  (setq *error* olderr)      ;restore old *error* handler
  (princ)
)
;;;------------------------MAIN PROGRAM----------------------------
;;;
(DEFUN C:AUTONOTE (/ SSET CMD DT DS TS ITS SM OM AS HL OSM LR APT BPT CPT TX;+
ANG SU CD PB BD EN OLDERR ANS)
(command "_-style" "arial"    "arial.ttf" 0 1    0 "_N" "_N")
(setq olderr *error* *error* err)
(SETQ CMD (GETVAR "CMDECHO"))
(setq pb (getvar "pickbox"))
(setq as (getvar "aperture"))
(setq su (getvar "snapunit"))
(setq ts (getvar "textsize"))
(setq hl (getvar "highlight"))
(setq sm (getvar "snapmode"))
(setq om (getvar "orthomode"))
(setq dt (getvar "dimtxt"))
;(setq lr (getvar "clayer"))
(setq osm (getvar "osmode"))
  (command "_.UNDO" "_g")
  (setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setvar "highlight" 0)
(if (= (getvar "dimscale") 0)
  (setq ds 1)
  (setq ds (getvar "dimscale"))
)
(setvar "osmode" 512)
  (if (or (> (getvar "userr1") 0) (> (getvar "userr2") 0))
    (progn
  (setq ans (strcase (getstring "\n<R>eset oder <Enter> um fortzusetzen> ")))
  (if (= ans "R")
    (progn
      (setvar "userr1" 0)
      (setvar "userr2" 0)
    )
  )
  )
    )
  (setq cd (* (getvar "userr1") 2))
(if (= cd 0)
  (progn
      (setq cd (getreal "\nBallondurchmesser <ENTER für Auswahl> "))
      (if (not (null cd))
      (setq cd (* ds cd)))
      (if (null cd)
        (progn
            (setq cd (entsel))
            (while (null cd)
              (prompt "\ndaneben... nochmal versuchen...")
              (setq cd (entsel))
            )
            (setq cd (* (cdr (assoc 40 (entget (car cd)))) 2))
        )
      )
  )
)
(setvar "userr1" (/ cd 2))
(setq cd (getvar "userr1"))
(if (= (getvar "userr2") 0)
  (progn
      (setq its (getreal "\nTexthöhe der Numerierung <ENTER für Auswahl> "))
      (if (not (null its))
      (setq its (* ds its)))
      (if (null its)
        (progn
            (setq its (entsel))
            (while (null its)
              (prompt "\ndaneben... nochmal versuchen...")
              (setq its (entsel))
            )
            (setq its (cdr (assoc 40 (entget (car its)))))
        )
      )
      (setvar "userr2" its)
  ))
  (setvar "textsize" (getvar "userr2"))
  (if (> (getvar "dimtxt") (getvar "userr2"))
      (setvar "dimtxt" (getvar "userr2"))
      (setvar "dimtxt" (getvar "dimtxt"))
  )
;  (command "layer" "u" "*" "")
;  (command "layer" "m" "dim" "c" "1" "dim" "")
  (setvar "aperture" 3)
  (setq apt (getpoint "\nLage der Pfeilspitze wählen <ENTER wenn keine>: ")) (princ)
  (if (not (null apt))
      (progn
        (setvar "snapmode" 1)
        (setq bpt (getpoint apt "\nzweiten Punkt wählen: "))
        (grdraw apt bpt -1)
        (setvar "orthomode" 1)
        (SETVAR "OSMODE" 0)
        (command "_snap" (* (getvar "dimscale") 0.125))
        (setq cpt (getpoint bpt "\nEndpunkt wählen <ENTER wenn ohne Fähnchen>: "))
        (redraw)
        (if (not (null cpt)) ;+
            (progn
              (command "_leader" apt bpt cpt "" "" "_n")
              (if (< (car cpt) (car bpt)) (setq bpt (subst (- (car cpt) cd) (
              car bpt) bpt))
              (setq bpt (subst (+ (car cpt) cd) (car bpt) bpt)))
              (command "_circle" bpt cd)
            )
            (progn
              (setq ang (angle apt bpt))
              (setq ang (strcat "@" (rtos cd 2) "<" (angtos ang 0 10)))
              (command "_leader" apt bpt "" "" "_n")
              (command "_circle" "_from" bpt ang cd)
              (setq bpt (cdr (assoc 10 (entget (entlast)))))
            )
        )
        (command "_redraw")
      ))
      (if (null apt)
        (progn
            (setvar "osmode" 16)
            (setvar "pickbox" 2)
            (setq bpt (getpoint "\nSelect side of balloon to attach to: "))
            (setq sset (ssget bpt))
            (setq en (ssname sset 0))
            (setq en (entget en))
            (setq apt (cdr (assoc 10 en)))
            (if (< (car apt) (car bpt)) (setq bpt (subst (+ (car bpt) cd) (car
            bpt) bpt)))
            (if (> (car apt) (car bpt)) (setq bpt (subst (- (car bpt) cd) (car
            bpt) bpt)))
            (if (< (cadr apt) (cadr bpt)) (setq bpt (subst (+ (cadr bpt) cd) (
            cadr bpt) bpt)))
            (if (> (cadr apt) (cadr bpt)) (setq bpt (subst (- (cadr bpt) cd) (
            cadr bpt) bpt)))
            (command "circle" bpt cd)
        ))
        (setvar "osmode" 0)
;        Einfügung für automatische Item-No.:
        (setq tx (itoa (setvar "useri5" (1+ (getvar "useri5")))))
;        (SETQ tx (getstring "\nItem number > "))
        (command "_text" "_m" bpt (getvar "textsize") "0" tx)
        (if (> (strlen tx) 2)
            (progn
              (setq en (entget (entlast)))
              (setq en (subst (cons 41 0.75) (assoc 41 en) en))
              (entmod en)
            ))
;          (command "chprop" "l" "" "c" "green" "")
            (setq bd (/ (getvar "dimtxt") 3))
            (setq bd (+ (* ds bd) cd))
            (setq tx (getstring T "\nTextanmerkung <ENTER wenn keine>: "))
            (if (< (strlen tx) 0) (command "_redraw")
            (+ (strlen tx) 0))
            (if (> (strlen tx) 0)
              (progn
                  (initget 1 "R L O U")
                  (setq ans;+
                  (getkword "\nauf welche Ballonseite soll die Textanmerkung? (R/L/O/U) > "))
                  (cond;+
                    ((= ans "L") (command "text" "mr" (subst (- (car bpt) bd) (
                    car bpt) bpt);+
                    (* ds (getvar "dimtxt")) "0" tx));+
                    ((= ans "R") (command "_text" "_ml" (subst (+ (car bpt) bd) (
                    car bpt) bpt);+
                    (* ds (getvar "dimtxt")) "0" tx));+
                    ((= ans "O") (command "_text" "_bc" (subst (+ (cadr bpt) bd)
                    (cadr bpt) bpt);+
                    (* ds (getvar "dimtxt")) "0" tx));+
                    ((= ans "U") (command "_text" "_tc" (subst (- (cadr bpt) bd)
                    (cadr bpt) bpt);+
                    (* ds (getvar "dimtxt")) "0" tx));+
                  )));
    ;            (command "chprop" "l" "" "c" "green" "")
      ;            (setvar "clayer" lr)
                  (setvar "highlight" hl)
                  (setvar "osmode" osm)
                  (setvar "orthomode" om)
                  (setvar "pickbox" pb)
                  (setvar "snapunit" su)
                  (setvar "textsize" ts)
                  (setvar "snapmode" sm)
                  (setvar "aperture" as)
                  (setvar "dimtxt" dt)
                  (setvar "cmdecho" cmd)
                  (setq *error* olderr)
                  (princ)
              )

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

---

Hallo Zec,

schau mal hier:
http://www.lehrer.uni-karlsruhe.de/~za685/cad/cadtools.htm

nach Tool 12

Gruß
Thedor Schönwald

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

---

Hallo Herr Schönwald,

danke für den hinweis, programm kenn ich schon.
deshalb meine frage kann mann lisp-technisch
das programm so umbauen das mann auch die startnummer eingeben kann.
leider bin ich auf diesem gebiet anfänger.

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