Message 1 of 7
While won't loop
Not applicable
07-20-2015
05:35 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi everyone,
I'm new to the AutoLISP programming and have a problem with my routine. This code should auto-nummerate some objects. I work with the AutoCAD MEP 2014
In this routine the While-Function doesn't loop (code is in German... if anyone has a problem i will translate the code):
(defun c:autonum ()
(setq p1 (getpoint "\nBitte Bereich auswählen (Links oben beginnen): "))
(setq p3 (getpoint "\nBitte Ecke unten Rechts angeben: "))
(setq p2 (list (car p1)(cadr p3)))
(setq p4 (list (car p3)(cadr p1)))
(setq sym (entget (car (entsel))))
(setq symname (cdr(assoc 2 sym)))
(setq sel1 (ssadd)) ; Auswahlsatz sel1 erstellen
(setq entdata (ssget "X" (list (cons 0 "INSERT")))) ; Alle Objekte des Typs "INSERT" werden ausgewählt
(setq i (sslength entdata)) ; Anzahl Objekte die sich im Auswahlsatz entdata befinden werden ausgezählt
(setq i (1- i))
(while (not(< i 0)) ; Erstelle Schleife und suche jedes Objekt nach symname ab
(setq ausw (ssname entdata i))
(setq auswerw (entget ausw))
(setq symnamecheck (cdr(assoc 2 auswerw)))
(if (eq (strcase symnamecheck) (strcase symname)) ; Wenn symnamecheck gleich ist wie symname dann wird Objekt zu Auswahlsatz sel1 hinzugefügt.
(progn
(ssadd ausw sel1)
)
)
(setq i (1- i))
)
(setq sel2 (ssadd))
(setq i (sslength sel1))
(setq i (1- i))
(setq posarray (list)) ; Erzeuge Array um von jedem Symbol die Position zu merken (Wird beim Nummerierungsschritt benötigt
(while (not(< i 0)) ; Bei dieser Schleife werden alle Objekte ermittelt, die sich im Auswahlrahmen befinden
(setq ausw (ssname sel1 i))
(setq auswerw (entget ausw))
(setq p1y (cadr p1))
(setq p2x (car p2))
(setq p3y (cadr p3))
(setq p4x (car p4))
(setq posx (cadr(assoc 10 auswerw)))
(setq posy (caddr(assoc 10 auswerw)))
(if (>= p1y posy) ; Hier wird geprüft ob sich das Objekt im Auswahlrahmen befindet
(progn
(if (<= p2x posx)
(progn
(if (<= p3y posy)
(progn
(if (>= p4x posx)
(progn
(ssadd ausw sel2) ; Wenn ja dann füge es zum Auswahlsatz sel2 hinzu
(setq posarray (append posarray (list posx) (list posy))) ; Füge die Position des Objektes in das Array ein
)
)
)
)
)
)
)
)
(setq i (1- i))
)
(sssetfirst nil sel2)
(setq z (sslength sel2))
(setq z (1- z))
(setq num (getstring "\nBeschriftung auf [X]-Achse oder auf [Y]-Achse: ")) ; Wie soll die Beschriftung erfolgen? Von Links nach Rechts (X-Achse) oder von Oben nach Unten (Y-Achse)
(cond ((or(= num "x")(= num "X")) ; Beschriftung auf X-Achse
(setq prfix (getstring "\nWird ein Präfix benötigt? Wenn ja, bitte eingeben: ")) ; Präfix der Nummerierung bspw. Geschoss-Buchstaben (A...
(setq zahl (getreal "\nBitte erste Nummer eingeben (nur ein Komma erlaubt!): ")) ; Erste Nummer eingeben
(setq sffix (getstring "\nWird ein Suffix benötigt? Wenn ja, bitte eingeben: ")) ; Suffix der Nummerierung bspw. Geschoss-Buchstaben (A....)
(setq schritt (getstring "\nBitte Nummerierungsschritt eingeben (z.B. +0.1): "))
(setq feld (getstring "\nWie heisst das Feld des Symbols das beschriftet werden soll (z.B. BEZ1): ")).
(while (not (< z 0)) ; This is the loop which won't loop
(setq q 0)
(setq number (rtos zahl))
(setq beschriftung (strcat prfix number sffix))
(setq n (entnext (ssname sel2 z)))
(setq e (entget n))
(while (not (eq q 1))
(if (eq (cdr (assoc 2 e)) feld)
(progn
(entmod (subst (cons 1 beschriftung) (assoc 1 e) e))
(entupd n)
(setq q 1)
)
)
(setq n (entnext n))
(setq e (entget n))
)
(setq number (atof schritt))
(setq number (+ zahl number))
(setq z (1- z))
) ;
)
)
)The first object will be edited and the other won't...
Can anyone help me? I'm really frustrated...
Thanks!
