---

Hallo zusammen,

ich suchen ein Lisp oder VBA welches mir alle Linien unter z.B. 10mm länge löscht.
ich hätte mir das so vorgestellt:
Programmstart => Abfrage nach der Länge unter der gelöscht werden soll=> Fenster in dem gelöscht weden soll. Es werden alle Linien unter der Länge gelöscht egal ob in Normteilen oder Blöcken.
Irgendwo sollte man im Programm noch Layer definieren können die aus dem Löschen ausgenommen werden z.B. AM_5 für Bemaßung.

Hat jemand so ein Programm oder ein ähnliches welches sich anpassen lässt?

Danke und Gruß Wolfgang

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

---

Hi Wolli,
in etwa so?

Code:

---

(defun c:shortdel (/      DEL-LEN   ERSTE INDEX    LIN-LEN
   OBJ      OBJDAT    SGET SGET-LEN  SGET2-LEN
   ZWEITE
  )
  (initget 7)
  (setq del-len (getreal
   "\nKurze Linien erfassen. Schwellwert für Länge eingeben: "
) ;_ end getreal
)
  (princ "\nObjekte wählen... Linien werden gefiltert...")
  (setq sget (ssget (list (cons 0 "LINE")))
sget-len (sslength sget)
sget2 (ssadd)
index 0
  ) ;_ end setq
  (while (< index sget-len)
    (setq obj   (ssname sget index)
  objdat  (entget obj)
  erste   (cdr (assoc 10 objdat))
  zweite  (cdr (assoc 11 objdat))
  lin-len (sqrt (+ (expt (- (car zweite) (car erste)) 2)
   (expt (- (cadr zweite) (cadr erste)) 2)
) ;_ end +
  ) ;_ end sqrt
    ) ;_ end setq
    (if (<= lin-len del-len)
      (setq sget2 (ssadd obj sget2))
    ) ;_ end if
    (setq index (1+ index))
  ) ;_ end while
  (setq sget2-len (sslength sget2))
  (princ
    (strcat "\nDWG analysiert. Schwellwert: \""
    (rtos del-len)
    "\""
    "\nLinien gesamt: \""
    (itoa sget-len)
    "\" / Linien kleiner/gleich Wert: \""
    (itoa sget2-len)
    "\""
    "\nErmittelte Linien gespeichert in \"!SGET2\"..."
    ) ;_ end strcat
  ) ;_ end princ
  (princ)
) ;_ end defun

(princ "\nKurze Linien erfassen. \"SHORTDEL\" startet das Programmm.")
(princ)

---

Löschen kannst Du dann mit der Befehlszeile. Bei der Frage nach den Objekten einfach !SGET2 eingeben (ausrufezeichen in Befehlszeile gibt den Wert für 'ne Lispvariable zurück). Oder bau' das löschen gleich mit ein (command "_.erase" sget2 "").

Alles weitere mußt Du dann schon einbauen, oder mit gesperrten Layern arbeiten.
Ciao,
Marc

[Diese Nachricht wurde von marc.scherer am 29. Januar 2002 editiert.]

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

---

Hallo Marc,

danke für Deine schnelle Hilfe.
Ich habs gleich ausprobiert, das Programm findet auch die richtige Anzahl der zu kuzen Linien (allerdings nicht die in Blöcken)

Das Löschen habe ich ans Ende gesetzt
...
...
) ;_ end defun
(command "_.erase" sget2 "")

aber es wird nichts gelöscht.

Kannst Du mir da noch einen kleinen Tipp geben.

Danke und Gruß Wolfgang

Befehl: shortdel

Kurze Linien erfassen. Schwellwert für Länge eingeben: 30

Objekte wählen... Linien werden gefiltert...
Objekte wählen: Entgegengesetzte Ecke angeben: 5 gefunden

Objekte wählen:

DWG analysiert. Schwellwert: "30"
Linien gesamt: "5" / Linien kleiner/gleich Wert: "2"
Ermittelte Linien gespeichert in "!SGET2"...

Befehl:

[Diese Nachricht wurde von Wolli am 29. Januar 2002 editiert.]

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

---

Hi,

Code:

---

(defun C:SHORTDEL (/      DEL-LEN   ERSTE INDEX    LIN-LEN
   OBJ      OBJDAT    SGET SGET-LEN  SGET2-LEN
   ZWEITE
  )
  (initget 7)
  (setq DEL-LEN
(getreal
   "\nKurze Linien erfassen. Schwellwert für Länge eingeben: "
) ;_ end getreal
  ) ;_ end setq
  (princ "\nObjekte wählen... Linien werden gefiltert...")
  (setq SGET (ssget (list (cons 0 "LINE")))
SGET-LEN (sslength SGET)
SGET2 (ssadd)
INDEX 0
  ) ;_ end setq
  (while (< INDEX SGET-LEN)
    (setq OBJ   (ssname SGET INDEX)
  OBJDAT  (entget OBJ)
  ERSTE   (cdr (assoc 10 OBJDAT))
  ZWEITE  (cdr (assoc 11 OBJDAT))
  LIN-LEN (sqrt (+ (expt (- (car ZWEITE) (car ERSTE)) 2)
   (expt (- (cadr ZWEITE) (cadr ERSTE)) 2)
) ;_ end +
  ) ;_ end sqrt
    ) ;_ end setq
    (if (<= LIN-LEN DEL-LEN)
      (setq SGET2 (ssadd OBJ SGET2))
    ) ;_ end if
    (setq INDEX (1+ INDEX))
  ) ;_ end while
  (if (> (sslength SGET2) 0)
    (progn
      (command "_.erase" SGET2 "")
      (princ (strcat "\nAlle Linien die kürzer als: \""
     (rtos DEL-LEN)
     "\" sind gelöscht !"
     ) ;_ end strcat
      ) ;_ end princ
    ) ;_ end progn
    (princ (strcat "\nKeine kurzen Linien für Schwellwert: \""
   (rtos DEL-LEN)
   "\" gefunden !"
   ) ;_ end strcat
    ) ;_ end princ
  ) ;_ end if
  (princ)
) ;_ end defun

(princ "\nKurze Linien erfassen. \"SHORTDEL\" startet das Programmm.")
(princ)

---

Löschen von Elementen INNERHALB von Blöcken, macht meiner Meinung nach KEINEN Sinn, wozu erstelle ich mir denn Standardsymbole? Um die nachher wieder kurz und klein zu "Lispeln"?
Ciao,
Marc

P.S. Cadmium hatte das mal erweitert: Siehe hier

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

---

Hallo Marc,

das mit den Blöcken ist so:
- Es gibt z.B. 30 Maschinen jede ist mit hilfe von Blöcken  strukturiert.
- Es wird ein Aufstellungsplan erstellt in den dann die Maschinen jeweils als Block eingefügt werden.
- Da die Dateigröße im Aufstellungsplan zu groß wird und es auf Details im Aufstellungsplan nicht ankommt sollen alle kurze Linien im Aufstellungsplan oder auch vorher in einer Kopie der Maschinen auch in Blöcken gelöscht werden.
Wenn es mit dem Löschen in den Blöcken nicht hinhaut dann wird es auch so gehen: Maschine um 100000 auf die Seite schieben, alles Ursprung bis zum geht nicht mehr, kurze Linien löschen, den Rest packen und als Block wieder an die richtige Stelle einfügen.

Danke für Deine Hilfe
Gruß Wolfgang

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