Integration der Funktionalität des Python Skripts in ein Lisp Skript, um den Umweg über DXF zu vermeiden und direkt in der Zeichnung arbeiten zu können
This commit is contained in:
@@ -0,0 +1,143 @@
|
||||
# VZAEHLER — Verbindungszähler für BricsCAD
|
||||
|
||||
Automatische Erkennung und Klassifikation von Linienschnittpunkten auf definierten Layern.
|
||||
|
||||
---
|
||||
|
||||
## Voraussetzungen
|
||||
|
||||
- BricsCAD mit LISP-Unterstützung
|
||||
- Zeichnung mit Linien (`LINE`) auf den zu prüfenden Layern
|
||||
- Skriptdatei: `verbindungszaehler.lsp`
|
||||
|
||||
> **Wichtig:** Es werden ausschließlich Verbindungspunkte erkannt, die auf der selben Z-Koordinate liegen.
|
||||
|
||||
---
|
||||
|
||||
## Installation
|
||||
|
||||
Skript laden:
|
||||
|
||||
```lisp
|
||||
(load "R:/pfad/zur/verbindungszaehler.lsp")
|
||||
```
|
||||
|
||||
Oder über die AutoCAD/BricsCAD Befehlszeile:
|
||||
|
||||
```
|
||||
APPLOAD → Datei auswählen → Laden
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## Verwendung
|
||||
|
||||
Befehl in der Befehlszeile eingeben:
|
||||
|
||||
```
|
||||
VZAEHLER
|
||||
```
|
||||
|
||||
### Eingabeaufforderungen
|
||||
|
||||
| Eingabe | Beschreibung | Default |
|
||||
|---|---|---|
|
||||
| Layer | Kommagetrennte Liste der zu prüfenden Layer | `D-1, D-5` |
|
||||
| Toleranz | Maximaler Abstand in Zeichnungseinheiten für Toleranzverbindungen | `0.50` |
|
||||
|
||||
Bei einfachem `Return` wird jeweils der Defaultwert verwendet.
|
||||
|
||||
**Beispiel:**
|
||||
|
||||
```
|
||||
===== VERBINDUNGSZAEHLER =====
|
||||
Layer (kommagetrennt) [D-1, D-5]: D-1, D-3
|
||||
Toleranz [0.50]:
|
||||
Layer : D-1 D-3
|
||||
Toleranz : 0.50
|
||||
------------------------------
|
||||
Linien gefunden: 42
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## Verbindungstypen
|
||||
|
||||
Das Skript unterscheidet drei Typen:
|
||||
|
||||
| Typ | Beschreibung | Erkennungslogik | Layer | Farbe |
|
||||
|---|---|---|---|---|
|
||||
| **Kreuzung** | Zwei Linien kreuzen sich, Schnittpunkt liegt im Inneren beider Linien | Nur echter geometrischer Schnitt, toleranzunabhängig | `D-KREUZUNG` | Rot (1) |
|
||||
| **T-Verbindung** | Ein Endpunkt liegt auf dem Inneren der anderen Linie | Toleranzbasiert | `D-T_VERBINDUNG` | Grün (3) |
|
||||
| **Eckverbindung** | Zwei Endpunkte berühren sich | Toleranzbasiert | `D-ECKVERBINDUNG` | Gelb (5) |
|
||||
|
||||
> **Wichtig:** Kreuzungen werden ausschließlich über echten geometrischen Schnitt erkannt — niemals über Toleranz. T-Verbindungen und Eckverbindungen werden niemals als Kreuzung klassifiziert, auch wenn sich die verlängerten Linien schneiden würden.
|
||||
|
||||
---
|
||||
|
||||
## Ergebnis in der Zeichnung
|
||||
|
||||
An jedem erkannten Verbindungspunkt wird ein Kreis (Radius 100 Einheiten) auf dem jeweiligen Ergebnislayer gezeichnet. Die Layer werden automatisch angelegt falls sie noch nicht existieren.
|
||||
|
||||
---
|
||||
|
||||
## Ausgabedatei
|
||||
|
||||
Nach der Auswertung wird automatisch eine Textdatei im Verzeichnis der Zeichnung erstellt:
|
||||
|
||||
```
|
||||
<Zeichnungsname>_<YYYYMMDD-HHMMSS>_vzaehler.txt
|
||||
```
|
||||
|
||||
**Beispiel:** `meinplan_20260507-143211_vzaehler.txt`
|
||||
|
||||
### Inhalt der Ausgabedatei
|
||||
|
||||
```
|
||||
================================================
|
||||
VERBINDUNGSZAEHLER - ERGEBNIS
|
||||
================================================
|
||||
|
||||
Datum/Zeit : 07.05.2026 14:32:11
|
||||
Zeichnung : R:\projekte\meinplan.dwg
|
||||
Layer : D-1, D-5
|
||||
|
||||
------------------------------------------------
|
||||
VERBINDUNGSTYPEN
|
||||
------------------------------------------------
|
||||
|
||||
Kreuzungen : 3
|
||||
T-Verbindungen : 8
|
||||
Eckverbindungen : 12
|
||||
|
||||
------------------------------------------------
|
||||
SUMMEN
|
||||
------------------------------------------------
|
||||
|
||||
Kreuzungen : 3
|
||||
Kontaktpunkte (T + Eck) : 20
|
||||
davon T-Verbindungen : 8
|
||||
davon Eckverbindungen : 12
|
||||
|
||||
GESAMT : 23
|
||||
|
||||
================================================
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## Toleranz — Hinweise
|
||||
|
||||
Die Toleranz wirkt **ausschließlich** auf T-Verbindungen und Eckverbindungen:
|
||||
|
||||
- Zu **klein**: Echte Verbindungen werden nicht erkannt (z.B. bei minimal versetzten Endpunkten durch Zeichenungenauigkeit)
|
||||
- Zu **groß**: Linien die sich nicht berühren werden fälschlich als verbunden gezählt
|
||||
- Empfehlung: Toleranz an die Zeichnungsgenauigkeit anpassen, typisch `0.1` bis `1.0` Zeichnungseinheiten (mm bei metrischer Konfiguration)
|
||||
|
||||
---
|
||||
|
||||
## Bekannte Einschränkungen
|
||||
|
||||
- Es werden nur Objekte vom Typ `LINE` ausgewertet — keine Polylinien, Bögen oder Splines
|
||||
- Die Auswertung erfolgt in 2D (XY-Ebene), Z-Koordinaten werden ignoriert
|
||||
- Bei sehr großen Zeichnungen (1000+ Linien) kann die Laufzeit spürbar steigen, da alle Linienpaare gegeneinander geprüft werden (O(n²))
|
||||
@@ -0,0 +1,587 @@
|
||||
(vl-load-com)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SAFE UTIL
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun safe-num (x)
|
||||
(if (numberp x) x 0.0)
|
||||
)
|
||||
|
||||
(defun safe-vec (v)
|
||||
(cond
|
||||
((and (listp v) (>= (length v) 2))
|
||||
(list (safe-num (car v)) (safe-num (cadr v))))
|
||||
((listp v)
|
||||
'(0.0 0.0))
|
||||
(T '(0.0 0.0))
|
||||
)
|
||||
)
|
||||
|
||||
(defun clean-point (p)
|
||||
(if (and p (listp p))
|
||||
(list
|
||||
(safe-num (car p))
|
||||
(safe-num (cadr p))
|
||||
)
|
||||
'(0.0 0.0)
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; LAYER MANAGEMENT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun ensure-layer (name color / doc layers layerObj)
|
||||
|
||||
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
|
||||
(setq layers (vla-get-Layers doc))
|
||||
|
||||
(if (not (tblsearch "LAYER" name))
|
||||
(setq layerObj (vla-add layers name))
|
||||
(setq layerObj (vla-item layers name))
|
||||
)
|
||||
|
||||
(vla-put-Color layerObj color)
|
||||
layerObj
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; GEOMETRY CORE
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun point-distance (a b)
|
||||
(sqrt
|
||||
(+ (expt (- (car a) (car b)) 2)
|
||||
(expt (- (cadr a) (cadr b)) 2)))
|
||||
)
|
||||
|
||||
(defun vec-sub (a b)
|
||||
(setq a (safe-vec a))
|
||||
(setq b (safe-vec b))
|
||||
(list (- (car a) (car b))
|
||||
(- (cadr a) (cadr b)))
|
||||
)
|
||||
|
||||
(defun point-distance-segment (p a b / ap ab denom t-val proj)
|
||||
(setq p (safe-vec p))
|
||||
(setq a (safe-vec a))
|
||||
(setq b (safe-vec b))
|
||||
(setq ap (vec-sub p a))
|
||||
(setq ab (vec-sub b a))
|
||||
;; GUARD: ab muss eine Liste mit 2 Zahlen sein
|
||||
(if (not (and (listp ab)
|
||||
(= (length ab) 2)
|
||||
(numberp (car ab))
|
||||
(numberp (cadr ab))))
|
||||
(point-distance p a) ;; Fallback
|
||||
(progn
|
||||
(setq denom (+ (* (car ab) (car ab))
|
||||
(* (cadr ab) (cadr ab))))
|
||||
(if (<= denom 1e-12)
|
||||
(point-distance p a)
|
||||
(progn
|
||||
(setq t-val (/ (+ (* (car ap) (car ab))
|
||||
(* (cadr ap) (cadr ab)))
|
||||
denom))
|
||||
(setq t-val (safe-num t-val))
|
||||
(if (< t-val 0.0) (setq t-val 0.0))
|
||||
(if (> t-val 1.0) (setq t-val 1.0))
|
||||
(setq proj (list (+ (car a) (* t-val (car ab)))
|
||||
(+ (cadr a) (* t-val (cadr ab)))))
|
||||
(point-distance p proj)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; Liegt ein Punkt strikt zwischen den Endpunkten einer Linie?
|
||||
;; (nicht am Endpunkt, mit kleiner Toleranz für numerischen Drift)
|
||||
(defun point-on-segment-interior (pt a b tol / t-val ab ap denom)
|
||||
(setq ab (vec-sub b a))
|
||||
(setq ap (vec-sub pt a))
|
||||
(setq denom (+ (* (car ab) (car ab)) (* (cadr ab) (cadr ab))))
|
||||
(if (<= denom 1e-12)
|
||||
nil
|
||||
(progn
|
||||
(setq t-val (/ (+ (* (car ap) (car ab)) (* (cadr ap) (cadr ab))) denom))
|
||||
;; "innen" = klar weg von beiden Endpunkten
|
||||
(and (> t-val (/ tol (sqrt denom)))
|
||||
(< t-val (- 1.0 (/ tol (sqrt denom)))))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Endpunkt-zu-Endpunkt Prüfung (Stoß-Erkennung)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun endpoints-touch-raw (l1 l2 tol / p1 p2 p3 p4)
|
||||
;; Rohpunkte direkt aus der Linienliste (clean-point bereits angewendet)
|
||||
(setq p1 (clean-point (car l1)))
|
||||
(setq p2 (clean-point (cadr l1)))
|
||||
(setq p3 (clean-point (car l2)))
|
||||
(setq p4 (clean-point (cadr l2)))
|
||||
(cond
|
||||
((< (point-distance p1 p3) tol) p1)
|
||||
((< (point-distance p1 p4) tol) p1)
|
||||
((< (point-distance p2 p3) tol) p2)
|
||||
((< (point-distance p2 p4) tol) p2)
|
||||
(T nil)
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; INTERSECTION CORE (SAFE + TOLERANT)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun intersect-lines (l1 l2 / o1 o2 result arr)
|
||||
|
||||
(setq o1 (vlax-ename->vla-object (caddr l1)))
|
||||
(setq o2 (vlax-ename->vla-object (caddr l2)))
|
||||
|
||||
(setq result
|
||||
(vl-catch-all-apply
|
||||
'vla-IntersectWith
|
||||
(list o1 o2 0)
|
||||
)
|
||||
)
|
||||
|
||||
(if (vl-catch-all-error-p result)
|
||||
nil
|
||||
(progn
|
||||
|
||||
(setq result
|
||||
(vl-catch-all-apply 'vlax-variant-value (list result))
|
||||
)
|
||||
|
||||
(if (vl-catch-all-error-p result)
|
||||
(setq result (vla-IntersectWith o1 o2 0))
|
||||
)
|
||||
|
||||
(setq arr
|
||||
(vl-catch-all-apply 'vlax-safearray->list (list result))
|
||||
)
|
||||
|
||||
(if (vl-catch-all-error-p arr)
|
||||
nil
|
||||
(if (>= (length arr) 3)
|
||||
(list (nth 0 arr) (nth 1 arr) 0.0)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PIPELINE INTERSECTION (MAIN BRAIN)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; normalize-point ersatzlos streichen
|
||||
|
||||
(defun find-intersection (l1 l2 tol / p1 p2 p3 p4 ip touch-pt)
|
||||
(if (not (and (listp l1) (listp (car l1))
|
||||
(listp l2) (listp (car l2))))
|
||||
nil
|
||||
(progn
|
||||
(setq p1 (clean-point (car l1)))
|
||||
(setq p2 (clean-point (cadr l1)))
|
||||
(setq p3 (clean-point (car l2)))
|
||||
(setq p4 (clean-point (cadr l2)))
|
||||
|
||||
;; Schritt 1: Endpunkt-Stoß
|
||||
(setq touch-pt (endpoints-touch-raw l1 l2 tol))
|
||||
(if touch-pt
|
||||
(cons touch-pt (classify-intersection touch-pt l1 l2 tol))
|
||||
|
||||
;; Schritt 2: Echter Schnitt
|
||||
(progn
|
||||
(setq ip (intersect-lines l1 l2))
|
||||
(if ip
|
||||
(progn
|
||||
;; Sicherheitsnetz: liegt SP nahe einem Endpunkt?
|
||||
(if (or (< (point-distance ip p1) tol)
|
||||
(< (point-distance ip p2) tol)
|
||||
(< (point-distance ip p3) tol)
|
||||
(< (point-distance ip p4) tol))
|
||||
(cons ip (classify-intersection ip l1 l2 tol))
|
||||
(if (and (point-on-segment-interior ip p1 p2 tol)
|
||||
(point-on-segment-interior ip p3 p4 tol))
|
||||
(cons ip "Kreuzung")
|
||||
(cons ip (classify-intersection ip l1 l2 tol))
|
||||
)
|
||||
)
|
||||
)
|
||||
;; Schritt 3: Toleranz-Fallback
|
||||
(cond
|
||||
((< (point-distance-segment p1 p3 p4) tol)
|
||||
(cons p1 (classify-intersection p1 l1 l2 tol)))
|
||||
((< (point-distance-segment p2 p3 p4) tol)
|
||||
(cons p2 (classify-intersection p2 l1 l2 tol)))
|
||||
((< (point-distance-segment p3 p1 p2) tol)
|
||||
(cons p3 (classify-intersection p3 l1 l2 tol)))
|
||||
((< (point-distance-segment p4 p1 p2) tol)
|
||||
(cons p4 (classify-intersection p4 l1 l2 tol)))
|
||||
(T nil)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; CLASSIFICATION
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun is-endpoint (pt line tol)
|
||||
(or
|
||||
(< (point-distance pt (car line)) tol)
|
||||
(< (point-distance pt (cadr line)) tol)
|
||||
)
|
||||
)
|
||||
|
||||
(defun classify-intersection (pt l1 l2 tol / e1 e2)
|
||||
|
||||
(setq e1 (is-endpoint pt l1 tol))
|
||||
(setq e2 (is-endpoint pt l2 tol))
|
||||
|
||||
(cond
|
||||
((and e1 e2) "Eckverbindung")
|
||||
((or e1 e2) "T-Verbindung")
|
||||
(T "Kreuzung")
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; DEDUP
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun point-exists (pt list tol)
|
||||
(vl-some
|
||||
'(lambda (p)
|
||||
(< (point-distance pt p) tol)
|
||||
)
|
||||
list
|
||||
)
|
||||
)
|
||||
|
||||
(defun count-by-type (lst typ)
|
||||
(length
|
||||
(vl-remove-if-not
|
||||
'(lambda (p) (= (caddr p) typ))
|
||||
lst
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; DRAW
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun create-circle (pt radius layer)
|
||||
(entmakex
|
||||
(list
|
||||
'(0 . "CIRCLE")
|
||||
(cons 8 layer)
|
||||
(cons 10 pt)
|
||||
(cons 40 radius)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; INPUT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun get-lines-by-layer (layers / ss i ent obj lines)
|
||||
|
||||
(setq lines '())
|
||||
|
||||
(foreach lay layers
|
||||
(setq ss
|
||||
(ssget "_X"
|
||||
(list '(0 . "LINE") (cons 8 lay))
|
||||
)
|
||||
)
|
||||
|
||||
(if ss
|
||||
(progn
|
||||
(setq i 0)
|
||||
(repeat (sslength ss)
|
||||
|
||||
(setq ent (ssname ss i))
|
||||
(setq obj (vlax-ename->vla-object ent))
|
||||
|
||||
(setq lines
|
||||
(cons
|
||||
(list
|
||||
(clean-point (vlax-get obj 'StartPoint))
|
||||
(clean-point (vlax-get obj 'EndPoint))
|
||||
ent
|
||||
)
|
||||
lines
|
||||
)
|
||||
)
|
||||
|
||||
(setq i (1+ i))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
lines
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TEXTDATEI-EXPORT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun write-report (all-pts filepath layers / f n-kr n-tv n-ek n-kontakt n-gesamt)
|
||||
(setq n-kr (count-by-type all-pts "Kreuzung"))
|
||||
(setq n-tv (count-by-type all-pts "T-Verbindung"))
|
||||
(setq n-ek (count-by-type all-pts "Eckverbindung"))
|
||||
(setq n-kontakt (+ n-tv n-ek))
|
||||
(setq n-gesamt (length all-pts))
|
||||
|
||||
(setq f (open filepath "w"))
|
||||
(if (not f)
|
||||
(prompt (strcat "\nFehler: Datei konnte nicht erstellt werden: " filepath))
|
||||
(progn
|
||||
(write-line "================================================" f)
|
||||
(write-line " VERBINDUNGSZAEHLER - ERGEBNIS" f)
|
||||
(write-line "================================================" f)
|
||||
(write-line "" f)
|
||||
(write-line (strcat " Datum/Zeit : " (menucmd "M=$(edtime,$(getvar,DATE),DD.MM.YYYY HH:MM:SS)")) f)
|
||||
(write-line (strcat " Zeichnung : " (vla-get-FullName (vla-get-ActiveDocument (vlax-get-acad-object)))) f)
|
||||
;; Layer-Zeile im Report dynamisch:
|
||||
(write-line
|
||||
(strcat " Layer : "
|
||||
(apply 'strcat
|
||||
(cons (car layers)
|
||||
(mapcar '(lambda (l) (strcat ", " l)) (cdr layers))
|
||||
)
|
||||
)
|
||||
)
|
||||
f
|
||||
)
|
||||
(write-line "" f)
|
||||
(write-line "------------------------------------------------" f)
|
||||
(write-line " VERBINDUNGSTYPEN" f)
|
||||
(write-line "------------------------------------------------" f)
|
||||
(write-line "" f)
|
||||
(write-line (strcat " Kreuzungen : " (itoa n-kr)) f)
|
||||
(write-line (strcat " T-Verbindungen : " (itoa n-tv)) f)
|
||||
(write-line (strcat " Eckverbindungen : " (itoa n-ek)) f)
|
||||
(write-line "" f)
|
||||
(write-line "------------------------------------------------" f)
|
||||
(write-line " SUMMEN" f)
|
||||
(write-line "------------------------------------------------" f)
|
||||
(write-line "" f)
|
||||
(write-line (strcat " Kreuzungen : " (itoa n-kr)) f)
|
||||
(write-line (strcat " Kontaktpunkte (T + Eck) : " (itoa n-kontakt)) f)
|
||||
(write-line (strcat " davon T-Verbindungen : " (itoa n-tv)) f)
|
||||
(write-line (strcat " davon Eckverbindungen : " (itoa n-ek)) f)
|
||||
(write-line "" f)
|
||||
(write-line (strcat " GESAMT : " (itoa n-gesamt)) f)
|
||||
(write-line "" f)
|
||||
(write-line "================================================" f)
|
||||
(close f)
|
||||
(prompt (strcat "\nBericht gespeichert: " filepath))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; INPUT MIT DEFAULTS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun prompt-layers (default-layers / input parts result)
|
||||
;; default-layers ist eine Liste z.B. '("D-1" "D-5")
|
||||
(setq input
|
||||
(getstring
|
||||
(strcat "\nLayer (kommagetrennt) ["
|
||||
(apply 'strcat
|
||||
(cons (car default-layers)
|
||||
(mapcar '(lambda (l) (strcat ", " l)) (cdr default-layers))
|
||||
)
|
||||
)
|
||||
"]: ")
|
||||
)
|
||||
)
|
||||
(if (= input "")
|
||||
default-layers
|
||||
;; Eingabe splitten an Komma, Whitespace trimmen
|
||||
(progn
|
||||
;; einfaches Splitten: Zeichen für Zeichen
|
||||
(setq parts (split-string-by input ","))
|
||||
(foreach p parts
|
||||
(setq p (string-trim p))
|
||||
(if (/= p "")
|
||||
(setq result (cons p result))
|
||||
)
|
||||
)
|
||||
(reverse result)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun prompt-tolerance (default-tol / input val)
|
||||
(setq input
|
||||
(getstring
|
||||
(strcat "\nToleranz [" (rtos default-tol 2 2) "]: ")
|
||||
)
|
||||
)
|
||||
(if (= input "")
|
||||
default-tol
|
||||
(progn
|
||||
(setq val (atof input))
|
||||
(if (> val 0.0)
|
||||
val
|
||||
(progn
|
||||
(prompt (strcat "\nUngueltige Toleranz, verwende Default: " (rtos default-tol 2 2)))
|
||||
default-tol
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; Hilfsfunktion: String an Trennzeichen splitten
|
||||
(defun split-string-by (str sep / result current i ch)
|
||||
(setq result '())
|
||||
(setq current "")
|
||||
(setq i 0)
|
||||
(while (< i (strlen str))
|
||||
(setq ch (substr str (1+ i) 1))
|
||||
(if (= ch sep)
|
||||
(progn
|
||||
(setq result (cons current result))
|
||||
(setq current "")
|
||||
)
|
||||
(setq current (strcat current ch))
|
||||
)
|
||||
(setq i (1+ i))
|
||||
)
|
||||
;; letztes Segment
|
||||
(setq result (cons current result))
|
||||
(reverse result)
|
||||
)
|
||||
|
||||
;; Hilfsfunktion: führende/nachfolgende Leerzeichen entfernen
|
||||
(defun string-trim (str / i j)
|
||||
(setq i 1)
|
||||
(setq j (strlen str))
|
||||
(while (and (<= i j) (= (substr str i 1) " "))
|
||||
(setq i (1+ i))
|
||||
)
|
||||
(while (and (>= j i) (= (substr str j 1) " "))
|
||||
(setq j (1- j))
|
||||
)
|
||||
(if (> j (1- i))
|
||||
(substr str i (- (1+ j) i))
|
||||
""
|
||||
)
|
||||
)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; MAIN COMMAND
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defun c:VZAEHLER (/ layers tol radius lines i j l1 l2 pt typ all-pts result report-path)
|
||||
|
||||
;; ── Defaults ────────────────────────────────────────────
|
||||
(setq default-layers '("D-1" "D-5"))
|
||||
(setq default-tol 0.5)
|
||||
|
||||
;; ── Benutzereingabe ──────────────────────────────────────
|
||||
(prompt "\n===== VERBINDUNGSZAEHLER =====")
|
||||
(setq layers (prompt-layers default-layers))
|
||||
(setq tol (prompt-tolerance default-tol))
|
||||
(setq radius 100)
|
||||
|
||||
(prompt (strcat "\nLayer : "))
|
||||
(foreach l layers (prompt (strcat l " ")))
|
||||
(prompt (strcat "\nToleranz : " (rtos tol 2 2)))
|
||||
(prompt "\n------------------------------")
|
||||
|
||||
;; ── Logik ────────────────────────────────────
|
||||
|
||||
(setq all-pts '())
|
||||
(setq lines (get-lines-by-layer layers))
|
||||
|
||||
(ensure-layer "D-KREUZUNG" 1)
|
||||
(ensure-layer "D-T_VERBINDUNG" 3)
|
||||
(ensure-layer "D-ECKVERBINDUNG" 5)
|
||||
|
||||
(prompt (strcat "\nLinien gefunden: " (itoa (length lines))))
|
||||
|
||||
(setq i 0)
|
||||
|
||||
(while (< i (length lines))
|
||||
|
||||
(setq j (+ i 1))
|
||||
|
||||
(while (< j (length lines))
|
||||
|
||||
(setq l1 (nth i lines))
|
||||
(setq l2 (nth j lines))
|
||||
|
||||
(setq result (find-intersection l1 l2 tol))
|
||||
(if result
|
||||
(progn
|
||||
(setq pt (car result)) ;; Punkt
|
||||
(setq typ (cdr result)) ;; Typ — direkt aus find-intersection
|
||||
(if (not (point-exists pt all-pts tol))
|
||||
(progn
|
||||
(setq all-pts (cons (list (car pt) (cadr pt) typ) all-pts))
|
||||
(cond
|
||||
((= typ "Kreuzung") (create-circle pt radius "D-KREUZUNG"))
|
||||
((= typ "T-Verbindung") (create-circle pt radius "D-T_VERBINDUNG"))
|
||||
((= typ "Eckverbindung") (create-circle pt radius "D-ECKVERBINDUNG"))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(setq j (1+ j))
|
||||
)
|
||||
|
||||
(setq i (1+ i))
|
||||
)
|
||||
|
||||
(prompt "\n\n===== ERGEBNIS =====")
|
||||
(prompt (strcat "\nKreuzungen: " (itoa (count-by-type all-pts "Kreuzung"))))
|
||||
(prompt (strcat "\nT-Verbindungen: " (itoa (count-by-type all-pts "T-Verbindung"))))
|
||||
(prompt (strcat "\nEckverbindungen: " (itoa (count-by-type all-pts "Eckverbindung"))))
|
||||
(prompt (strcat "\nGESAMT: " (itoa (length all-pts))))
|
||||
|
||||
;; ── Report schreiben ──────────────────────────────────────
|
||||
(setq dwg-name
|
||||
(vla-get-Name (vla-get-ActiveDocument (vlax-get-acad-object)))
|
||||
)
|
||||
;; ".dwg" abschneiden falls vorhanden
|
||||
(if (wcmatch dwg-name "*.dwg")
|
||||
(setq dwg-name (substr dwg-name 1 (- (strlen dwg-name) 4)))
|
||||
)
|
||||
(setq timestamp
|
||||
(menucmd "M=$(edtime,$(getvar,DATE),YYYYMMDD-HHMMSS)")
|
||||
)
|
||||
(setq report-path
|
||||
(strcat
|
||||
(vla-get-Path (vla-get-ActiveDocument (vlax-get-acad-object)))
|
||||
"\\"
|
||||
dwg-name
|
||||
"_"
|
||||
timestamp
|
||||
"_vzaehler.txt"
|
||||
)
|
||||
)
|
||||
|
||||
(write-report all-pts report-path layers)
|
||||
|
||||
(princ)
|
||||
)
|
||||
Reference in New Issue
Block a user