Merge branch 'master' of https://gitea.schoenenberger.de/Schoenenberger_Systeme_GmbH/dxfmakros
This commit is contained in:
+35
-24
@@ -992,6 +992,7 @@
|
||||
ss n i j obj obj-liste kette segmente seg
|
||||
startpunkt endpunkt-ref deltaH grade antwort idx
|
||||
as-seite es-seite as-block es-block
|
||||
gf-as-winkel gf-es-winkel
|
||||
entry-hz exit-hz
|
||||
first-idx last-idx neu-l
|
||||
aktuell-frame nach-aus-pt
|
||||
@@ -1059,22 +1060,27 @@
|
||||
(setq entry-hz (cadr (car segmente)))
|
||||
(setq exit-hz (gf-exit-hz segmente))
|
||||
|
||||
;; Seite fuer AUS-Element (vor Winkelberechnung, da Laengenanpassung davon abhaengt)
|
||||
;; AUS-Element: 30/90 (vor Seite), dann Seite (vor Winkelberechnung, da die
|
||||
;; Laengenanpassung von der AS/ES-Masse abhaengt). Masse fuer Variante setzen.
|
||||
(setq gf-as-winkel (vf-frage-element-winkel "vf-winkel-aus-header"))
|
||||
(princ (ssg-text "gf-seite-aus-header"))
|
||||
(princ (ssg-text "gf-seite-links"))
|
||||
(princ (ssg-text "gf-seite-rechts"))
|
||||
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
|
||||
(setq as-seite (if (= antwort "2") "rechts" "links"))
|
||||
(vf-set-as-masse gf-as-winkel as-seite)
|
||||
|
||||
;; Seite fuer EIN-Element
|
||||
;; EIN-Element: 30/90 + Seite
|
||||
(setq gf-es-winkel (vf-frage-element-winkel "vf-winkel-ein-header"))
|
||||
(princ (ssg-text "gf-seite-ein-header"))
|
||||
(princ (ssg-text "gf-seite-links"))
|
||||
(princ (ssg-text "gf-seite-rechts"))
|
||||
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
|
||||
(setq es-seite (if (= antwort "2") "rechts" "links"))
|
||||
(vf-set-es-masse gf-es-winkel es-seite)
|
||||
|
||||
(setq as-block (strcat "AS_Element_90_" as-seite))
|
||||
(setq es-block (strcat "ES_Element_90_" es-seite))
|
||||
(setq as-block (strcat "AS_Element_" gf-as-winkel "_" as-seite))
|
||||
(setq es-block (strcat "ES_Element_" gf-es-winkel "_" es-seite))
|
||||
|
||||
;; Segmentlaengen anpassen.
|
||||
;; Die gezeichneten Linien enthalten die Laengen von AUS-/EIN-Element UND Separatoren.
|
||||
@@ -1165,8 +1171,9 @@
|
||||
(while (and (< iter 4) (> (abs (- grade grade-prev)) 0.001))
|
||||
(setq grade-prev grade)
|
||||
(setq rad-v-korr (* grade (/ pi 180.0)))
|
||||
;; AS-Element: KS_EIN zeigt 90 Grad zur Fahrtrichtung
|
||||
(setq ein-hz-as-k (if (= as-seite "rechts") (+ entry-hz 90.0) (- entry-hz 90.0)))
|
||||
;; AS-Element: gemessener Ebenen-Schwenk -> KS_EIN so, dass KS_AUS entlang hz
|
||||
(setq ein-hz-as-k (- entry-hz
|
||||
(vf-element-plan-turn (strcat "AS_Element_" gf-as-winkel "_" as-seite))))
|
||||
(setq rad-h-as-k (* (float ein-hz-as-k) (/ pi 180.0)))
|
||||
(setq xu-as-meas (list (* (cos rad-h-as-k)(cos rad-v-korr))
|
||||
(* (sin rad-h-as-k)(cos rad-v-korr))
|
||||
@@ -1226,11 +1233,10 @@
|
||||
|
||||
;; AUS-Element: KS_EIN so ausrichten, dass KS_AUS in Fahrtrichtung entry-hz zeigt.
|
||||
;; Beweis: KS_AUS.xu = -yu(target-frame). Fuer KS_AUS||entry-hz gilt:
|
||||
;; rechts (Rechtskurve): KS_EIN = entry-hz + 90deg
|
||||
;; links (Linkskurve): KS_EIN = entry-hz - 90deg
|
||||
(setq ein-hz-as (if (= as-seite "rechts")
|
||||
(+ entry-hz 90.0)
|
||||
(- entry-hz 90.0)))
|
||||
;; Gemessener Ebenen-Schwenk des AS-Blocks -> KS_EIN so drehen, dass KS_AUS
|
||||
;; entlang der Fahrtrichtung hz zeigt (ein-hz = hz - plan-turn).
|
||||
(setq ein-hz-as (- entry-hz
|
||||
(vf-element-plan-turn (strcat "AS_Element_" gf-as-winkel "_" as-seite))))
|
||||
(setq rad-h-as (* (float ein-hz-as) (/ pi 180.0)))
|
||||
(setq rad-v-as (* (float grade) (/ pi 180.0)))
|
||||
(setq xu-entry (list (* (cos rad-h-as)(cos rad-v-as))
|
||||
@@ -1519,15 +1525,18 @@
|
||||
|
||||
;; deltaL-total: gesamte Horizontaldistanz (fuer DELTA_L-Attribut)
|
||||
;; hz: Fahrtrichtung in Grad (0=Ost, 90=Nord, 180=West, 270=Sued)
|
||||
(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt as-seite es-seite hz deltaL-total /
|
||||
(defun gefaellestrecke-einfuegen (L_stau winkel startpunkt as-seite es-seite hz deltaL-total
|
||||
as-winkel es-winkel /
|
||||
as-block es-block endpunkt
|
||||
gf-nummer last-ent rad-hz rad-v xu-incl
|
||||
ein-hz rad-ein xu-ein
|
||||
startframe aktuell-frame
|
||||
stau-endpunkt sep-endpunkt sep-frame
|
||||
gf-deltaH L-gf-str nach-aus-pt gf-insert)
|
||||
(setq as-block (strcat "AS_Element_90_" as-seite))
|
||||
(setq es-block (strcat "ES_Element_90_" es-seite))
|
||||
(if (null as-winkel) (setq as-winkel "90"))
|
||||
(if (null es-winkel) (setq es-winkel "90"))
|
||||
(setq as-block (strcat "AS_Element_" as-winkel "_" as-seite))
|
||||
(setq es-block (strcat "ES_Element_" es-winkel "_" es-seite))
|
||||
(if (not *lib-initialized*) (gf-init-bibliothek))
|
||||
|
||||
;; GF-Nummer und Entity-Grenze vor erster Einfuegung
|
||||
@@ -1541,11 +1550,9 @@
|
||||
(* (sin rad-hz)(cos rad-v))
|
||||
(- (sin rad-v))))
|
||||
|
||||
;; KS_EIN-Richtung fuer AS-Element: so dass KS_AUS in Fahrtrichtung hz zeigt.
|
||||
;; Beweis: KS_AUS.xu = -yu (target-frame), yu = links-senkrecht zu xu.
|
||||
;; rechts (Rechtskurve): KS_AUS = KS_EIN - 90deg => KS_EIN = hz + 90deg
|
||||
;; links (Linkskurve): KS_AUS = KS_EIN + 90deg => KS_EIN = hz - 90deg
|
||||
(setq ein-hz (if (= as-seite "rechts") (+ hz 90.0) (- hz 90.0)))
|
||||
;; KS_EIN-Richtung fuer AS-Element: gemessener Ebenen-Schwenk des Blocks, so
|
||||
;; dass KS_AUS in Fahrtrichtung hz zeigt (ein-hz = hz - plan-turn).
|
||||
(setq ein-hz (- hz (vf-element-plan-turn (strcat "AS_Element_" as-winkel "_" as-seite))))
|
||||
(setq rad-ein (* (float ein-hz) (/ pi 180.0)))
|
||||
(setq xu-ein (list (* (cos rad-ein)(cos rad-v))
|
||||
(* (sin rad-ein)(cos rad-v))
|
||||
@@ -1618,7 +1625,7 @@
|
||||
;; ============================================================
|
||||
|
||||
(defun c:GEFAELLESTRECKE ( / antwort eingabe-modus deltaL winkel rad L_stau sep-x
|
||||
as-seite es-seite
|
||||
as-seite es-seite gf-as-winkel gf-es-winkel
|
||||
line-points startpunkt endpunkt differenz
|
||||
deltaX deltaY startpunkt-fuer-einfuegen hz-winkel)
|
||||
|
||||
@@ -1729,21 +1736,25 @@
|
||||
)
|
||||
)
|
||||
|
||||
;; Seite AUS-Element waehlen
|
||||
;; AUS-Element: 30/90 (vor Seite) + Seite, dann Masse fuer Variante setzen
|
||||
(setq gf-as-winkel (vf-frage-element-winkel "vf-winkel-aus-header"))
|
||||
(princ (ssg-text "gf-seite-aus-header"))
|
||||
(princ (ssg-text "gf-seite-links"))
|
||||
(princ (ssg-text "gf-seite-rechts"))
|
||||
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
|
||||
(setq as-seite (if (= antwort "2") "rechts" "links"))
|
||||
(vf-set-as-masse gf-as-winkel as-seite)
|
||||
|
||||
;; Seite EIN-Element waehlen
|
||||
;; EIN-Element: 30/90 + Seite
|
||||
(setq gf-es-winkel (vf-frage-element-winkel "vf-winkel-ein-header"))
|
||||
(princ (ssg-text "gf-seite-ein-header"))
|
||||
(princ (ssg-text "gf-seite-links"))
|
||||
(princ (ssg-text "gf-seite-rechts"))
|
||||
(setq antwort (getstring (ssg-text "prompt-wahl-1-2")))
|
||||
(setq es-seite (if (= antwort "2") "rechts" "links"))
|
||||
(vf-set-es-masse gf-es-winkel es-seite)
|
||||
|
||||
;; Laengenberechnung
|
||||
;; Laengenberechnung (aus-dx/ein-dx jetzt fuer die gewaehlte Variante)
|
||||
;; deltaL = aus_dx + L_stau*cos(rad) + sep*cos(rad) + ein_dx
|
||||
(setq sep-x (* (ssg-cfg-or "gefaelle" "separator_breite" 300.0) (cos rad)))
|
||||
(setq L_stau (/ (- deltaL aus-dx ein-dx sep-x) (cos rad)))
|
||||
@@ -1768,7 +1779,7 @@
|
||||
;; Bestaetigung
|
||||
(setq antwort (getstring (ssg-text "gf-prompt-einfuegen")))
|
||||
(if (not (= antwort "2"))
|
||||
(gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen as-seite es-seite hz-winkel deltaL)
|
||||
(gefaellestrecke-einfuegen L_stau (fix winkel) startpunkt-fuer-einfuegen as-seite es-seite hz-winkel deltaL gf-as-winkel gf-es-winkel)
|
||||
(princ (ssg-text "gf-status-abgebrochen"))
|
||||
)
|
||||
)
|
||||
|
||||
@@ -73,11 +73,11 @@
|
||||
;; Attribut-Definitionen: ((TAG DEFAULT) ...)
|
||||
(setq *kreisel-attrib-defs*
|
||||
'(("NAME" "")
|
||||
("DREHRICHTUNG" "UZS")
|
||||
("N_SEPARATOREN" "2")
|
||||
("KREISELART" "STANDARD")
|
||||
("N_SCANNER" "0")
|
||||
("N_RAMPEN" "0")
|
||||
("DREHRICHTUNG" "UZS")
|
||||
("ANZAHL_SEPARATOR" "2")
|
||||
("KREISELART" "STANDARD")
|
||||
("ANZAHL_SCANNER" "0")
|
||||
("N_RAMPEN" "0")
|
||||
("DREHUNG" "0")
|
||||
("ABSTAND" "2300")
|
||||
("NUMMER" "0")
|
||||
|
||||
@@ -0,0 +1,356 @@
|
||||
;;; ============================================================
|
||||
;;; count_sep_scan.lsp - Eigenstaendiges Zaehl-Werkzeug
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Zaehlt die manuell platzierten Bloecke "Scanner" und
|
||||
;;; "Separator_SP" je ILS-Block (Kreisel / VarioFoerderer /
|
||||
;;; Gefaellestrecke) und schreibt die Anzahlen in die Attribute
|
||||
;;; des jeweiligen ILS-Blocks. Anschliessend QSAVE.
|
||||
;;;
|
||||
;;; Zuordnung eines Sensors zu einem ILS-Block:
|
||||
;;; - Der geometrische Mittelpunkt (X/Y) des Sensors (Zentrum
|
||||
;;; seiner eigenen Bounding-Box, unabhaengig vom $INSBASE)
|
||||
;;; muss in der achsparallelen Bounding-Box des ILS-Blocks
|
||||
;;; liegen (Z wird ignoriert).
|
||||
;;; - Liegt der Punkt in mehreren Boxen (Ueberlappung), wird
|
||||
;;; der ILS-Block mit dem naechstgelegenen Box-Zentrum gewaehlt.
|
||||
;;; - Ein optionaler Toleranzrand (*senstol*) vergroessert die
|
||||
;;; Box, damit Sensoren knapp am Rand noch erfasst werden.
|
||||
;;;
|
||||
;;; Aufruf: ZAEHLE_SEP_SCAN
|
||||
;;; Laden: per APPLOAD oder (load "count_sep_scan")
|
||||
;;; ============================================================
|
||||
|
||||
(vl-load-com)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; KONFIGURATION (bei Bedarf anpassen)
|
||||
;;; ------------------------------------------------------------
|
||||
|
||||
;; Toleranzrand um die ILS-Block-Box in Zeichnungseinheiten (mm).
|
||||
;; 0.0 = exakte Box. Groesserer Wert = Sensoren knapp ausserhalb
|
||||
;; werden noch dem ILS-Block zugerechnet.
|
||||
(if (null *senstol*) (setq *senstol* 0.0))
|
||||
|
||||
;; Blockname-Muster (wcmatch, Grossschreibung) fuer die manuell
|
||||
;; platzierten Sensoren.
|
||||
(setq *scanner-pattern* "SCANNER,SCANNER_*")
|
||||
(setq *separator-pattern* "SEPARATOR_SP,SEPARATOR_SP_*")
|
||||
|
||||
;; Blockname-Muster fuer die INTERN im ILS-Block (in der Kette)
|
||||
;; gezeichneten Separatoren. Diese bilden die Basis fuer
|
||||
;; ANZAHL_SEPARATOR und werden bei jedem Lauf frisch gezaehlt.
|
||||
(setq *intern-separator-pattern* "STAUSTRECKE_SEPARATOR_SP*")
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; ILS-Block-Erkennung und zugehoerige Attribut-Tags
|
||||
;;; Alle ILS-Bloecke (Kreisel / VF / GF) verwenden einheitlich
|
||||
;;; ANZAHL_SCANNER und ANZAHL_SEPARATOR.
|
||||
;;; Rueckgabe: (scanner-tag separator-tag) oder nil
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-carrier-tags (nm / up)
|
||||
(setq up (strcase nm))
|
||||
(if (or (wcmatch up "KREISEL_*")
|
||||
(wcmatch up "VF_*")
|
||||
(wcmatch up "GF_*"))
|
||||
(list "ANZAHL_SCANNER" "ANZAHL_SEPARATOR")
|
||||
nil
|
||||
)
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Sensor-Erkennung
|
||||
;;; Rueckgabe: 'scanner | 'separator | nil
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-sensor-kind (nm / up)
|
||||
(setq up (strcase nm))
|
||||
(cond
|
||||
((wcmatch up *scanner-pattern*) 'scanner)
|
||||
((wcmatch up *separator-pattern*) 'separator)
|
||||
(t nil)
|
||||
)
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Punkt-Rueckgabe von vla-getboundingbox in eine Liste wandeln.
|
||||
;;; BricsCAD liefert ein Safearray, AutoCAD ein Variant mit
|
||||
;;; Safearray - beide Faelle werden hier abgedeckt.
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-pt->list (v)
|
||||
(cond
|
||||
((= (type v) 'variant) (vlax-safearray->list (vlax-variant-value v)))
|
||||
((= (type v) 'safearray) (vlax-safearray->list v))
|
||||
((listp v) v)
|
||||
(t nil)
|
||||
)
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Bounding-Box eines INSERT holen (WCS, achsparallel).
|
||||
;;; Erzwingt vorher ein vla-update (Regen des Objekts), da
|
||||
;;; vla-getboundingbox sonst auf nicht-regenerierten oder auf
|
||||
;;; eingefrorenen Layern liegenden Bloecken scheitert.
|
||||
;;; Rueckgabe: (minx miny maxx maxy) oder nil bei Fehler.
|
||||
;;; *cs-last-error* enthaelt bei Fehler den echten COM-Fehlertext.
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-bbox (ent / obj res)
|
||||
(setq *cs-last-error* nil)
|
||||
(setq obj (vlax-ename->vla-object ent))
|
||||
;; Objekt regenerieren (Fehler ignorieren)
|
||||
(vl-catch-all-apply 'vla-update (list obj))
|
||||
(setq res
|
||||
(vl-catch-all-apply
|
||||
'(lambda ( / ll ur)
|
||||
(vla-getboundingbox obj 'll 'ur)
|
||||
(list (cs-pt->list ll) (cs-pt->list ur)))))
|
||||
(if (vl-catch-all-error-p res)
|
||||
(progn
|
||||
(setq *cs-last-error* (vl-catch-all-error-message res))
|
||||
nil)
|
||||
(list (car (car res)) (cadr (car res)) ;; minx miny
|
||||
(car (cadr res)) (cadr (cadr res))) ;; maxx maxy
|
||||
)
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Referenzpunkt eines Sensors: geometrischer Mittelpunkt seiner
|
||||
;;; eigenen Bounding-Box (X/Y). Unabhaengig vom $INSBASE der
|
||||
;;; Sensor-DWG. Fallback auf den Einfuegepunkt, falls die Box
|
||||
;;; nicht ermittelbar ist.
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-sensor-point (ent ed / bb)
|
||||
(setq bb (cs-bbox ent))
|
||||
(if bb
|
||||
(list (/ (+ (nth 0 bb) (nth 2 bb)) 2.0)
|
||||
(/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
|
||||
(cdr (assoc 10 ed))
|
||||
)
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Liegt Punkt pt (X/Y) in ILS-Block-Record rec (mit Toleranz)?
|
||||
;;; rec = (ename tagScan tagSep minx miny maxx maxy cx cy)
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-in-box (pt rec / x y)
|
||||
(setq x (car pt) y (cadr pt))
|
||||
(and (>= x (- (nth 3 rec) *senstol*))
|
||||
(<= x (+ (nth 5 rec) *senstol*))
|
||||
(>= y (- (nth 4 rec) *senstol*))
|
||||
(<= y (+ (nth 6 rec) *senstol*)))
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Sensor-Punkt einem ILS-Block zuordnen.
|
||||
;;; Rueckgabe: ILS-Block-Record oder nil (keine Zuordnung).
|
||||
;;; Bei mehreren Treffern: naechstes Box-Zentrum (X/Y).
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-assign (pt carriers / matches best bestd d)
|
||||
(setq matches nil)
|
||||
(foreach rec carriers
|
||||
(if (cs-in-box pt rec) (setq matches (cons rec matches))))
|
||||
(cond
|
||||
((null matches) nil)
|
||||
((= (length matches) 1) (car matches))
|
||||
(t
|
||||
(setq best nil bestd nil)
|
||||
(foreach rec matches
|
||||
(setq d (distance (list (car pt) (cadr pt))
|
||||
(list (nth 7 rec) (nth 8 rec))))
|
||||
(if (or (null bestd) (< d bestd))
|
||||
(setq bestd d best rec)))
|
||||
best)
|
||||
)
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Zaehler in einer Assoc-Liste (Schluessel = ename) erhoehen.
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-bump (alist key / pair)
|
||||
(setq pair (assoc key alist))
|
||||
(if pair
|
||||
(subst (cons key (1+ (cdr pair))) pair alist)
|
||||
(cons (cons key 1) alist))
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Attributwert an einem INSERT setzen (Tag ohne Gross/Klein).
|
||||
;;; Rueckgabe: T wenn Tag gefunden und gesetzt, sonst nil.
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-set-att (ins tag val / e ed done ok)
|
||||
(setq e (entnext ins) done nil ok nil)
|
||||
(while (and e (not done))
|
||||
(setq ed (entget e))
|
||||
(cond
|
||||
((= (cdr (assoc 0 ed)) "ATTRIB")
|
||||
(if (= (strcase (cdr (assoc 2 ed))) (strcase tag))
|
||||
(progn
|
||||
(entmod (subst (cons 1 val) (assoc 1 ed) ed))
|
||||
(entupd e)
|
||||
(setq ok t))))
|
||||
((= (cdr (assoc 0 ed)) "SEQEND") (setq done t))
|
||||
)
|
||||
(setq e (entnext e))
|
||||
)
|
||||
ok
|
||||
)
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Zaehlt rekursiv, wie oft ein Block (Muster pat) in der
|
||||
;;; Definition des Blocks bname verwendet wird - inklusive
|
||||
;;; verschachtelter Unterbloecke. Damit wird die interne Anzahl
|
||||
;;; der Kette-Separatoren aus der Geometrie ermittelt.
|
||||
;;; ------------------------------------------------------------
|
||||
(defun cs-count-nested (bname pat / e ed nm n stop)
|
||||
(setq n 0 stop nil)
|
||||
(setq e (tblobjname "BLOCK" bname))
|
||||
(if e
|
||||
(progn
|
||||
(setq e (entnext e))
|
||||
(while (and e (not stop))
|
||||
(setq ed (entget e))
|
||||
(cond
|
||||
((= (cdr (assoc 0 ed)) "ENDBLK") (setq stop t))
|
||||
((= (cdr (assoc 0 ed)) "INSERT")
|
||||
(setq nm (cdr (assoc 2 ed)))
|
||||
(if (wcmatch (strcase nm) pat)
|
||||
(setq n (1+ n))
|
||||
(setq n (+ n (cs-count-nested nm pat)))))
|
||||
)
|
||||
(if (not stop) (setq e (entnext e)))
|
||||
)
|
||||
)
|
||||
)
|
||||
n
|
||||
)
|
||||
|
||||
;;; ============================================================
|
||||
;;; HAUPTBEFEHL
|
||||
;;; ============================================================
|
||||
(defun c:ZAEHLE_SEP_SCAN ( / ss i ent ed nm tags bb cx cy
|
||||
carriers scanpts seppts kind pt
|
||||
scanCounts sepCounts
|
||||
rec en nm2 ns nsep internSep newS newP
|
||||
n-scan-unassigned n-sep-unassigned
|
||||
okS okP)
|
||||
(setq carriers nil scanpts nil seppts nil)
|
||||
|
||||
;; Vor der Extents-Berechnung einmal regenerieren, damit
|
||||
;; vla-getboundingbox verlaessliche Werte liefert.
|
||||
(vl-catch-all-apply '(lambda () (command "_.REGEN")))
|
||||
|
||||
;; --- 1. Alle INSERTs sammeln und klassifizieren ---
|
||||
(setq ss (ssget "_X" '((0 . "INSERT"))))
|
||||
(if (null ss)
|
||||
(progn (princ "\n>>> Keine Bloecke in der Zeichnung gefunden.") (princ))
|
||||
(progn
|
||||
(setq i 0)
|
||||
(while (< i (sslength ss))
|
||||
(setq ent (ssname ss i))
|
||||
(setq ed (entget ent))
|
||||
(setq nm (cdr (assoc 2 ed)))
|
||||
(setq tags (cs-carrier-tags nm))
|
||||
(cond
|
||||
;; --- ILS-Block ---
|
||||
(tags
|
||||
(setq bb (cs-bbox ent))
|
||||
(if bb
|
||||
(progn
|
||||
(setq cx (/ (+ (nth 0 bb) (nth 2 bb)) 2.0))
|
||||
(setq cy (/ (+ (nth 1 bb) (nth 3 bb)) 2.0))
|
||||
(setq carriers
|
||||
(cons (list ent (car tags) (cadr tags)
|
||||
(nth 0 bb) (nth 1 bb) (nth 2 bb) (nth 3 bb)
|
||||
cx cy)
|
||||
carriers)))
|
||||
(princ (strcat "\n! Bounding-Box fehlgeschlagen fuer ILS-Block '" nm "'"
|
||||
(if *cs-last-error*
|
||||
(strcat " (" *cs-last-error* ")") "")))
|
||||
)
|
||||
)
|
||||
;; --- Sensor ---
|
||||
(t
|
||||
(setq kind (cs-sensor-kind nm))
|
||||
(if kind
|
||||
(progn
|
||||
(setq pt (cs-sensor-point ent ed))
|
||||
(if (eq kind 'scanner)
|
||||
(setq scanpts (cons pt scanpts))
|
||||
(setq seppts (cons pt seppts)))))
|
||||
)
|
||||
)
|
||||
(setq i (1+ i))
|
||||
)
|
||||
|
||||
;; --- 2. Sensoren den ILS-Bloecken zuordnen ---
|
||||
(setq scanCounts nil sepCounts nil
|
||||
n-scan-unassigned 0 n-sep-unassigned 0)
|
||||
|
||||
(foreach pt scanpts
|
||||
(setq rec (cs-assign pt carriers))
|
||||
(if rec
|
||||
(setq scanCounts (cs-bump scanCounts (car rec)))
|
||||
(setq n-scan-unassigned (1+ n-scan-unassigned))))
|
||||
|
||||
(foreach pt seppts
|
||||
(setq rec (cs-assign pt carriers))
|
||||
(if rec
|
||||
(setq sepCounts (cs-bump sepCounts (car rec)))
|
||||
(setq n-sep-unassigned (1+ n-sep-unassigned))))
|
||||
|
||||
;; --- 3. Attribute setzen und Bericht ausgeben ---
|
||||
(princ "\n============================================")
|
||||
(princ "\n Sensor-Zaehlung je ILS-Block")
|
||||
(princ "\n============================================")
|
||||
(if (null carriers)
|
||||
(princ "\n (Keine ILS-Bloecke KREISEL_/VF_/GF_ gefunden)")
|
||||
(foreach rec carriers
|
||||
(setq en (car rec))
|
||||
(setq nm2 (cdr (assoc 2 (entget en))))
|
||||
(setq ns (cond ((assoc en scanCounts) (cdr (assoc en scanCounts))) (t 0)))
|
||||
(setq nsep (cond ((assoc en sepCounts) (cdr (assoc en sepCounts))) (t 0)))
|
||||
;; interne Kette-Separatoren frisch aus der Blockdefinition zaehlen
|
||||
(setq internSep (cs-count-nested nm2 *intern-separator-pattern*))
|
||||
;; Scanner = nur neu zugeordnete
|
||||
;; Separator = interne Kette-Separatoren + neu zugeordnete
|
||||
(setq newS ns)
|
||||
(setq newP (+ internSep nsep))
|
||||
;; gefundene Anzahlen melden
|
||||
(princ (strcat "\n " nm2
|
||||
": Scanner(neu)=" (itoa ns)
|
||||
", Separator intern=" (itoa internSep)
|
||||
" + manuell=" (itoa nsep)))
|
||||
;; Werte schreiben und Ergebnis bestaetigen
|
||||
(setq okS (cs-set-att en (nth 1 rec) (itoa newS)))
|
||||
(setq okP (cs-set-att en (nth 2 rec) (itoa newP)))
|
||||
(if (and okS okP)
|
||||
(princ (strcat "\n -> geschrieben: "
|
||||
"ANZAHL_SCANNER=" (itoa newS)
|
||||
", ANZAHL_SEPARATOR=" (itoa newP)))
|
||||
(princ (strcat "\n -> FEHLER beim Schreiben: "
|
||||
(if okS "" "ANZAHL_SCANNER fehlt ")
|
||||
(if okP "" "ANZAHL_SEPARATOR fehlt"))))
|
||||
)
|
||||
)
|
||||
(princ (strcat "\n--------------------------------------------"
|
||||
"\n ILS-Bloecke gesamt: " (itoa (length carriers))
|
||||
"\n Scanner gesamt: " (itoa (length scanpts))
|
||||
" (nicht zugeordnet: " (itoa n-scan-unassigned) ")"
|
||||
"\n Separator gesamt: " (itoa (length seppts))
|
||||
" (nicht zugeordnet: " (itoa n-sep-unassigned) ")"))
|
||||
(if (or (> n-scan-unassigned 0) (> n-sep-unassigned 0))
|
||||
(princ (strcat "\n Hinweis: Nicht zugeordnete Sensoren liegen"
|
||||
"\n ausserhalb aller ILS-Block-Boxen. Ggf. *senstol*"
|
||||
"\n erhoehen oder Platzierung pruefen.")))
|
||||
|
||||
;; --- 4. Zeichnung speichern ---
|
||||
(princ "\n--------------------------------------------")
|
||||
(princ "\n Speichere Zeichnung (QSAVE) ...")
|
||||
(command "_.QSAVE")
|
||||
(princ "\n>>> Fertig.")
|
||||
(princ)
|
||||
)
|
||||
)
|
||||
(princ)
|
||||
)
|
||||
|
||||
(princ "\n>>> count_sep_scan.lsp geladen. Befehl: ZAEHLE_SEP_SCAN")
|
||||
(princ)
|
||||
+93
-1
@@ -680,6 +680,88 @@
|
||||
(rtos (car P-out) 2 2) (rtos (cadr P-out) 2 2) (rtos (caddr P-out) 2 2))))
|
||||
(list P-out xu-out yu-out zu-out))
|
||||
|
||||
;; ============================================================
|
||||
;; AS-/ES-Element: Winkel-Variante (30 / 90 Grad)
|
||||
;; ============================================================
|
||||
;; Masse (KS_EIN->KS_AUS als (dx dy dz)) eines Elements aus dem Block ziehen.
|
||||
(defun vf-element-masse (blockname / temp-obj ks-data ke ka)
|
||||
(ensure-block-loaded blockname)
|
||||
(if (not (tblsearch "BLOCK" blockname))
|
||||
nil
|
||||
(progn
|
||||
(setq temp-obj (vla-InsertBlock modelspace
|
||||
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
|
||||
(setq ks-data (extract-ks-from-block temp-obj))
|
||||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||||
(setq ke (cadr (assoc "KS_EIN" ks-data)) ka (cadr (assoc "KS_AUS" ks-data)))
|
||||
(if (and ke ka)
|
||||
(list (- (caar ka) (caar ke))
|
||||
(- (cadr (car ka)) (cadr (car ke)))
|
||||
(- (caddr (car ka)) (caddr (car ke))))
|
||||
nil))))
|
||||
|
||||
;; Ebenen-Schwenk (Grad) eines Elements: Winkel von KS_EIN.xu nach KS_AUS.xu in
|
||||
;; der XY-Ebene, direkt aus dem Block gemessen (unabhaengig davon, ob 30/90-Turn
|
||||
;; oder gerade). Wird genutzt, um KS_EIN so zu drehen, dass KS_AUS entlang hz
|
||||
;; zeigt: ein-hz = hz - plan-turn. Fallback 90 (Vorgabe fuer 90-Grad-Element).
|
||||
(defun vf-element-plan-turn (blockname / temp-obj ks-data fe fa)
|
||||
(ensure-block-loaded blockname)
|
||||
(if (not (tblsearch "BLOCK" blockname))
|
||||
90.0
|
||||
(progn
|
||||
(setq temp-obj (vla-InsertBlock modelspace
|
||||
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
|
||||
(setq ks-data (extract-ks-from-block temp-obj))
|
||||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||||
(setq fe (ks-frame-extract (cadr (assoc "KS_EIN" ks-data))))
|
||||
(setq fa (ks-frame-extract (cadr (assoc "KS_AUS" ks-data))))
|
||||
(if (and fe fa)
|
||||
(- (* (atan (cadr (cadr fa)) (car (cadr fa))) (/ 180.0 pi))
|
||||
(* (atan (cadr (cadr fe)) (car (cadr fe))) (/ 180.0 pi)))
|
||||
90.0))))
|
||||
|
||||
;; KS-Info eines Elements (im Block, Einbau-Rotation 0):
|
||||
;; Rueckgabe (ein-ang aus-ang vx vy)
|
||||
;; ein-ang / aus-ang : Ebenen-Winkel (Grad) von KS_EIN.xu bzw. KS_AUS.xu
|
||||
;; vx / vy : KS_AUS.origin - KS_EIN.origin (Block-XY)
|
||||
;; Damit laesst sich die KS_AUS-Lage + Achsrichtung analytisch vorausberechnen.
|
||||
(defun vf-element-ks-info (blockname / temp-obj ks-data fe fa)
|
||||
(ensure-block-loaded blockname)
|
||||
(if (not (tblsearch "BLOCK" blockname))
|
||||
nil
|
||||
(progn
|
||||
(setq temp-obj (vla-InsertBlock modelspace
|
||||
(vlax-3D-point '(0 0 0)) blockname 1.0 1.0 1.0 0))
|
||||
(setq ks-data (extract-ks-from-block temp-obj))
|
||||
(if (not (vlax-erased-p temp-obj)) (vla-Delete temp-obj))
|
||||
(setq fe (ks-frame-extract (cadr (assoc "KS_EIN" ks-data))))
|
||||
(setq fa (ks-frame-extract (cadr (assoc "KS_AUS" ks-data))))
|
||||
(if (and fe fa)
|
||||
(list (* (atan (cadr (cadr fe)) (car (cadr fe))) (/ 180.0 pi))
|
||||
(* (atan (cadr (cadr fa)) (car (cadr fa))) (/ 180.0 pi))
|
||||
(- (car (car fa)) (car (car fe)))
|
||||
(- (cadr (car fa)) (cadr (car fe))))
|
||||
nil))))
|
||||
|
||||
;; 30/90-Wahl fuer ein AS/ES-Element. Rueckgabe: "30" oder "90" (Vorgabe 90).
|
||||
;; headerkey: i18n-Key fuer die Kopfzeile ("vf-winkel-aus-header" oder
|
||||
;; "vf-winkel-ein-header"). Rueckgabe: "30" oder "90" (Default 90).
|
||||
(defun vf-frage-element-winkel (headerkey)
|
||||
(princ (ssg-text headerkey))
|
||||
(princ (ssg-text "vf-winkel-90"))
|
||||
(princ (ssg-text "vf-winkel-30"))
|
||||
(if (= (getstring (ssg-text "prompt-wahl-1-2")) "2") "30" "90"))
|
||||
|
||||
;; AS-/ES-Masse-Globals (aus-dx/dy/dz bzw. ein-dx/dy/dz) fuer die gewaehlte
|
||||
;; Winkel-/Seiten-Variante neu setzen (fuer berechne-alle-winkel, GF-Winkel,
|
||||
;; Trimmungen). Ohne gueltigen Block bleiben die Werte unveraendert.
|
||||
(defun vf-set-as-masse (winkel seite / m)
|
||||
(setq m (vf-element-masse (strcat "AS_Element_" winkel "_" seite)))
|
||||
(if m (setq aus-dx (car m) aus-dy (cadr m) aus-dz (caddr m))))
|
||||
(defun vf-set-es-masse (winkel seite / m)
|
||||
(setq m (vf-element-masse (strcat "ES_Element_" winkel "_" seite)))
|
||||
(if m (setq ein-dx (car m) ein-dy (cadr m) ein-dz (caddr m))))
|
||||
|
||||
;; hz: horizontale Fahrtrichtung in Grad (0=Ost/+X, 90=Nord/+Y, ...),
|
||||
;; winkel: vertikale Neigung in Grad. Rotation = Rz(hz)*Ry(winkel).
|
||||
(defun insert-inclined-scaled-block (blockname startpunkt laenge winkel hz /
|
||||
@@ -1159,7 +1241,17 @@
|
||||
;; vf_linienzug.lsp. Dispatcht hier direkt und beendet den Standard-Ablauf.
|
||||
(if (= anlage-typ "linienzug")
|
||||
(progn
|
||||
(vf-linienzug-modus)
|
||||
(princ "\n\nLinienzug-Modus waehlen:")
|
||||
(princ "\n 1 - Manuelle Eingabe (Punkte klicken)")
|
||||
(princ "\n 2 - 3D-Objekte + Ziel-Hoehe (Randwert-Solver, fertig)")
|
||||
(princ "\n 3 - 3D-Objekte stueckweise (Vorwaerts-Nachbau, in Arbeit)")
|
||||
(setq wahl (getint "\nIhre Wahl (1/2/3) [1]: "))
|
||||
;; Konsolen-Nummer -> interne Funktion:
|
||||
;; 2 = fertiger Ziel-Hoehe-Modus (intern vf-linienzug-modus3)
|
||||
;; 3 = alter Vorwaerts-Nachbau (intern vf-linienzug-modus2, wird umgebaut)
|
||||
(cond ((= wahl 2) (vf-linienzug-modus3))
|
||||
((= wahl 3) (vf-linienzug-modus2))
|
||||
(t (vf-linienzug-modus)))
|
||||
(exit)
|
||||
)
|
||||
)
|
||||
|
||||
+1029
-31
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user