---

Hallo.
Ich suche eine Flächenberechnung für AC 2000i oder 200x.
Ich bin dabei fündig geworden bei industrie.com . dort gibt es die Lisp-Tools FLAE2 und FLAECHE2 . Es wäre jetzt toll wenn man beides miteinander kombinieren könnte.
- Flae2 schreibt noch einen kleinen Raumstempel in die Fläche
- Flaeche2 kann verschiedene Flächen auswählen

Bei beiden taucht jedoch ein Problem auf das der Text mit einem Winkel eingetragen wird. Es wäre auch super wenn bei der Position der Texte der aktuell eingestellte Schriftfont genommen würde.

Wer hat da eine Idee oder den Ergeiz das ganze mal in eine gute Form zu bringen?
Hier die Lisp anweisungen:

FLAE2
;; ##########################################################
;; |  FLAE2.LSP  (c)1999 Dipl.- Ing. (FH) Ralf Roletschek  |
;; |    im Auftrag: Ingenieurbüro KUJUS, Wölsickendorf    |
;; +--------------------------------------------------------+
;; | internationale Version - läuft in allen Sprachen      |
;; | getestet für AutoCAD R14 und 2000                      |
;; +--------------------------------------------------------+
;; | Ermittlung von Flächeninhalt und Umfang beliebiger    |
;; | geometrischer Formen in AutoCAD 12ff                  |
;; | Ausgabe als Text in der Zeichnung uns als Textfile    |
;; | zur Weiterverarbeitung in einer Datenbank              |
;; +--------------------------------------------------------+
;; | Laden des Programmes: "appload" an der Befehlszeile    |
;; |                      dann die Datei "FLAE2.LSP"      |
;; |                      auswählen und laden              |
;; | Start des Programmes: danach steht in AutoCAD die neue |
;; |                      Funktion "uf" zur Verfügung      |
;; +--------------------------------------------------------+
;; | das Programm erwartet folgende Eingaben:              |
;; |    - ein Punkt innerhalb einer geschlossenen Struktur  |
;; |    - Eingabe eines Flächentyps                        |
;; |    - Eingabe einer Flächennummer                      |
;; |    - Zeigen der Lage der Beschriftungen für            |
;; |          1. Fläche                                    |
;; |          2. Unfang                                    |
;; |          3. Typ und Nummer der Fläche                  |
;; ##########################################################

(defun c:uf ( / obj flae umfa)
(setq filename "flae.dat")
  (setq trenn    " ; ")
  (setq nachkomma 4)
  (Setq BLIALT (getvar "blipmode"))
(Setq CMDALT (getvar "cmdecho"))
(Setq OSMALT (getvar "osmode"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
  (terpri)
(SETQ obj (getpoint "Punkt in der Fläche"))
  (command "_.boundary" obj "")
  (command "_.area" "o" "_last")
  (setq flae (getvar "area"))
  (setq umfa (getvar "perimeter"))
(terpri)
  (setq _typ (getstring "Flächentyp : "))
  (setq _num (getstring "Nummer : "))
  (alert (strcat
"Fläche = "  (rtos flae 2 nachkomma)
                    "\nUmfang = " (rtos umfa 2 nachkomma)
    "\nTyp " _typ " |  Nr. " _num
          )
  )
  (princ)
  (terpri)
(setq file (open "flae.dat" "a"))
(write-line (strcat
      _typ
trenn
_num
trenn
(rtos flae 2 nachkomma)
trenn
(rtos umfa 2 nachkomma)
    )
file)
  (close file)
  (setq p_flae (getpoint "Einfügepunkt für Fläche"))
  (setq s_flae (strcat "A = " (rtos Flae 2 nachkomma)))
  (command "_.text" p_flae "" "" s_Flae)
(terpri)
  (setq p_umfa (getpoint "Einfügepunkt für Umfang"))
  (setq s_umfa (strcat "U = " (rtos umfa 2 nachkomma)))
  (command "_.text" p_umfa "" "" s_umfa)
  (terpri)
(setq p_text (getpoint "Einfügepunkt für Beschreibung"))
  (setq s_text (strcat _typ " | " _num))
  (command "_.text" p_text "" "" s_text)
(setvar "blipmode" BLIALT)
(setvar "cmdecho" CMDALT)
(setvar "OSMODE" OSMALT)
)
(alert "Das Programm ist ordnungsgemäß geladen
      \nAufruf mit uf ---> enter")
---------------------------------------------------------------

FLAECHE2

; Programm zur Flächenermittlung
; Das Programm ist Freeware -
; Der Autor (Ernst Dietrich) übernimmt daher keinerlei Haftungen.
; Die Benutzung erfolgt auf eigene Gefahr !
; 28.08.2003:  Es wurden kleinere Korrekturen vorgenommen

(defun c:ff (/ pkt apkt p1 dist anfragetxt)
  (command "_.UNDO" "_END")
  (command "_.UNDO" "_GROUP")
  (setvar "PLINETYPE" 2)
  (setq olderr *error*)
  (setq *error* ederr)
  (setq vorlay (getvar "CLAYER"))
  (if (not konf)
    (flkonfig)
  )
  (if (not komst)
    (rundg)
  )
  (setq pkt T)
  (eingab)
  (while pkt
    (if umf
      (progn
        (if (not (= pkt "Objekt"))
          (flsolid)
        )
        (setq anfragetxt (strcat "\nFläche = " (rtos flaech) " / " (rtos flaech 2 komst)
                                        " m² - Beschriften: Nein=Enter/<<Textmitte>> "))
        (if (= 'LIST (type (setq einfpkt (getpoint anfragetxt))))
          (beschr)
        )
        (if (= pkt "Objekt")
          (progn
            (redraw umf 4)
            (command "_.ERASE" sol "")
          )
          (command "_.ERASE" umf sol "")
        )
      )
    )
    (eingab)
  )
  (command "CLAYER" vorlay)
  (command "_.UNDO" "_END")
  (princ)
)
;-------------------------------------------------------------------------
(defun eingab ()  ;Eingabe einer Option oder Punkt in der Fläche
  (osm0)
  (initget 128 "Objekt Umfahrung Konfig Rundg")
  (setq pkt (getpoint "\nObjekt/Umfahrung/Konfig/Rundung/<<Punkt für automatisch:>> "))
  (osmz)
  (cond
    ((= pkt "Objekt") (objekt-berech))
    ((= pkt "Umfahrung") (umf-berech))
    ((= pkt "Konfig")
      (flkonfig)
      (eingab)
    )
    ((= pkt "Rundg")
      (rundg)
      (eingab)
    )
    (pkt (pkt-berech))
  )
)
;-------------------------------------------------------------------------
(defun rundg () 
  (if (not (setq komst (getint "\nFlächentext runden auf wieviele Kommastellen: <0> ")))
    (setq komst 0)
  )
)
;-------------------------------------------------------------------------
(defun objekt-berech (/ obj)
  (setq obj (entsel "\nPolylinie oder Kreis wählen: "))
  (setq umf (car obj))
  (redraw umf 3)
  (command "_.AREA" "O" obj)
)
;-------------------------------------------------------------------------
(defun umf-berech (/ anfragetxt) ;Umfahrung
  (setq pkt (setq p1 (getpoint "\nErster Punkt: ")))
  (command "_PLINE" p1)
  (while (setq pkt (getpoint pkt "\nNächster Punkt: <Schliessen> "))
    (osm0)
    (command pkt)
    (if pkt
      (progn
        (setq dist (distance p1 pkt))
        (princ (strcat "\nEntfernung= "(rtos dist 2 2) " m"))
        (setq p1 pkt)
      )
    )
    (osmz)
  )
  (command "S")
  (setq umf (entlast))
  (flsolid)
  (command "_.AREA" "O" umf)
  (setq flaech (getvar "AREA"))
  (setq anfragetxt (strcat "\nFläche = " (rtos flaech) " / " (rtos flaech 2 komst) " m² - Beschriften: Nein=Enter/<<Textmitte>> "))
  (if (= 'LIST (type (setq einfpkt (getpoint anfragetxt))))
    (beschr)
  )
  (command "_.ERASE" umf sol "")
  (eingab)
)
;----------------------------------------------------------------------
(defun pkt-berech (/ lastnach lastvor)
  (load "c:/temp/VORAUSW")
  (vorauswahl)
  (command "_LAYER" "_T" "0" "")
  (command "CLAYER" 0)
  (setq lastvor (entlast))
  (command "_boundary" "O" "U" "N" aws "" "X" pkt "")
  (setq lastnach (entlast))
  (if (equal lastvor lastnach)
    (progn
      (setq umf nil)
      (setq flaech "")
      (alert "Keine gültige Umgrenzung gefunden")
    )
    (progn
      (setq umf (entlast))
      (redraw umf 3)
      (command "_.AREA" "O" umf)
      (setq flaech (getvar "AREA"))
    )
  )
)
;----------------------------------------------------------------------
(defun flsolid (/ counter lay)        ;zeigt die gefundene Fläche durch ein temporäres Solid an
  (if (not aws)                        ; wenn Auswahlsatz "aws" nicht existiert
    (progn                               
      (setq aws (ssadd))            ; erstelle den Auswahlsatz "aws" neu und
      (ssadd (entlast) aws)        ; füge das zuletzt erstellte Objekt hinzu.
    )
  )
  (command "REGENAUTO" 0)
  (setq lay "flsolid")
  (if (tblsearch "layer" lay)
    (command "_layer" "_s" lay "")
    (command "_layer" "m" lay "fa" "251" ""  "")
  )
  (command "_HATCH" "solid" umf "")
  (setq sol (entlast))
  (command "_draworder" "L" "" "N" (ssname aws 0))        ;das letzte Objekt wird unter die erste Grenze gelegt.
  (entupd sol)
  (setq counter 0)
  (repeat (sslength aws)
    (entupd (ssname aws counter))
    (setq counter (1+ counter))
  )
  (command "REGENAUTO" 1)
  (command "CLAYER" vorlay)
)
;----------------------------------------------------------------------
(defun beschr (/ txt)
;  (command "_.ERASE" umf sol "")
  (if (not (tblsearch "layer" "flaeche"))
    (command "_LAYER" "_M" "flaeche" "_C" "8" "" "")
    (command "CLAYER" "flaeche")
  )
  (setq txt (strcat (rtos flaech 2 komst) " m2"))
  (command "_.TEXT" "_J" "MZ" einfpkt 2 (+ (vt) 100) txt)  ;den Wert 100 entsprechend korrigieren
)
;----------------------------------------------------------------------
(defun ederr (s)
  (print s)
  (command "_.ERASE" umf sol "")
  (setq *error* olderr)
)
;----------------------------------------------------------------------
;diese Funktion fragt um Objekte, deren Layer wiederum als Filter für die Flächenberechnung
;verwendet werden. Mit den Layernamen wird das LSP-File VORAUSW erzeugt, welches dann
;die Objekte zur Flächenberechnung auswählt.

(defun flkonfig ()
  (initget 128 "Wie")
  (setq obj (nentsel "\nWelche Layer - Objekte anklicken/Wie bisher: <Voreinstellung> "))
  (cond
    ((= obj "Wie") (princ "\nBisherige Layer werden verwendet"))
    ((not obj) (stdard))        ;Layer laut Voreinstellung
    (obj (neuausw))
  )
  (setq konf T)
)
;----------------------------------------------------------------------
(defun neuausw (/ laynam lspfile)  ;Layer anklicken
  (setq lspfile (open "c:\\temp\\vorausw.lsp" "w"))
  (princ "(defun vorauswahl ()\n" lspfile)
  (princ "  (setq aws (ssget \"X\"\n" lspfile)
  (princ "    '((-4 . \"<or\")" lspfile)
  (while obj
    (princ "\n      " lspfile)
    (prin1 (cons 8 (setq laynam (cdr (assoc 8 (entget (car obj)))))) lspfile)
    (print laynam)
    (setq obj (nentsel "\nWelche Layer berücksichtigen - Objekte anklicken: "))  )
  (princ "\n    (-4 . \"or>\"))" lspfile)
  (princ "\n  ))" lspfile)
  (princ "\n)" lspfile)
  (close lspfile)
)
;----------------------------------------------------------------------
(defun stdard (/ lspfile)  ;Default-Layer
  (setq lspfile (open "c:\\temp\\vorausw.lsp" "w"))
  (princ "(defun vorauswahl ()\n" lspfile)
  (princ "  (setq aws (ssget \"X\"\n" lspfile)
  (princ "    '((-4 . \"<or\")" lspfile)
 
; hier können die Layer für die Voreinstellung eingetragen werden - jetzt nur "0", Layer "abc" und "def" vorbereitet
  (princ "\n      " lspfile) (prin1 (cons 8 "0") lspfile)
;  (princ "\n      " lspfile) (prin1 (cons 8 "abc") lspfile)
;  (princ "\n      " lspfile) (prin1 (cons 8 "def") lspfile)

  (princ "\n    (-4 . \"or>\"))" lspfile)
  (princ "\n  ))" lspfile)
  (princ "\n)" lspfile)
  (close lspfile)
)
;----------------------------------------------------------------------
(defun osm0 ()
  (setq osm (getvar "osmode"))
  (setvar "OSMODE" 0)
)
;------------------------------------------------------------------------------
(defun osmz ()
  (setvar "OSMODE" osm)
)
;----------------------------------------------------------------------
(defun vt ()
  (cvunit (getvar "viewtwist") "radiant" "neugrad")
)

;XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

(princ "\nStart mit  ff  ")

--------------------------------------------------------------

Ich hoffe ich hab alles richtig erklärt.

Gruß Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hi Kodat,
hast Du mal versucht die Autoren der Tools -Ralf Roletschek- und -Ernst Dietrich- zu kontaktieren?
Ich denke wenn man was am Code verändert haben möchte, ist der Autor immer die erste Adresse, schließlich freut der sich auch mal davon zu hören wer seinen Code verwendet und welche Wünsche da offen geblieben sind...

------------------
Ciao,
Marc

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

---

Hallo.
Ja das wäre eigentlich das erste was man machen sollte.

Werds mal probieren. Vielleicht kann jemand in der Zwischenzeit ja
schon Tips geben.

Gruß Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hi

Der Flächentext wird mit dieser Funktion geschrieben:

;----------------------------------------------------------------------
(defun beschr (/ txt)
;  (command "_.ERASE" umf sol "")
  (if (not (tblsearch "layer" "flaeche"))
    (command "_LAYER" "_M" "flaeche" "_C" "8" "" "")
    (command "CLAYER" "flaeche")
  )
  (setq txt (strcat (rtos flaech 2 komst) " m2"))
  (command "_.TEXT" "_J" "MZ" einfpkt 2 (+ (vt) 100) txt)  ;den Wert 100 entsprechend korrigieren
);----------------------------------------------------------------------

Ändere einfach die letzte Zeile
  (command "_TEXT" ...
entsprechend Deinen Wünschen. Die Richtung wird durch (+ (vt) 100) = VIEWTWIST + 100 bestimmt. Gib stattdessen einfach Deine gewünschte Richtung ein.

------------------
Gruß, Ernst
www.geopaint.at

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

---

Hallo.
Danke für den Tip.
Das habe ich hinbekommen. HAb versucht jemanden von den Autoren zu erreichen, aber vergebens.
Das Toll funktioniert gut. Muss aber danach den Text editieren da es kein Mtext ist und immer in qmm ausgegeben wird. Wir zeichnen meisten in CM.
Wer hat denn noch eine Idee den Text als Mtext zu ersetzen und vielleicht noch cm einzustellen (optimal wäre natürlich vorher die Einhait abzufragen) ?

Gruß Carsten

cm zeichne

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hallo Carsten,

wenn ihr in cm zeichnet (1 Zeicheneinheit = 1 cm) dann ist die Fläche auch in cm². Es wird immer nur m² drangeschrieben, siehe zeile (setq txt (...) "m2"). Hie kannst Du genausogut "cm2" hinschreiben. Ggf. erforderliche Umrechnungen der Flächen müssten nach der Flächenermittlung erfolgen, z. b. (setq flaech (* flaech 10000)) wenn in m gezeichnet und cm2 ausgegeben werden sollen.

Gruß
spider

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

---

Hallo.
Geht irgendwie nicht. Vielleicht hab ich es auch falsch eingetragen.
Wie muss ich die Zeile austauschen?

Gruß Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hallo Carsten,
da Du nicht konkret gesagt hast, wass Du genau gemacht hast, kann man nur raten was nicht geht.
Also:
Folgende Annahmen: Ihr zeichnet in cm (1 ZE = 1 cm), dann erhälst Du die Flächen in cm2
Die Flächen sollen in mm2 ausgegeben werden

Dazu Zeile:
(setq txt (strcat (rtos flaech 2 komst) " m2"))

ersetzen mit Zeilen:
(setq flaech (* flaech 100)) ; Umrechnung cm2 in mm2
(setq txt (strcat (rtos flaech 2 komst) " mm2"))

Ich hoffe ich lieg richtig, wenn nicht, ist das ganze entsprechend anzupassen

Gruss
spider

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

---

Ich weis nicht ob das hilft. Wir zeichnen im mm und Fläschenangaben machen wir aber in m². So habe ich mir das Lisp eine Berechung für Fläche und Umfang eingafügt.

(defun c:uf ( / obj flae umfa)
(setq filename "flae.dat")
  (setq trenn    " ; ")
  (setq nachkomma 1)
  (Setq BLIALT (getvar "blipmode"))
(Setq CMDALT (getvar "cmdecho"))
(Setq OSMALT (getvar "osmode"))
(setvar "blipmode" 0)
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
  (terpri)
(SETQ obj (getpoint "Punkt in der Fläche"))
  (command "_.boundary" obj "")
  (command "_.area" "o" "_last")
  (setq flae (getvar "area"))
  (setq umfa (getvar "perimeter"))
(terpri)
  (setq _typ (getstring "Flächentyp : "))
  (setq _num (getstring "Nummer : "))
  (princ)
  (terpri)
(setq file (open "flae.dat" "a"))
(write-line (strcat
      _typ
trenn
_num
trenn
(rtos flae 2 nachkomma)
trenn
(rtos umfa 2 nachkomma)
    )
file)
  (close file)
  (setq p_flae (getpoint "Einfügepunkt für Fläche"))
  (setq s_flae (strcat "A = " (rtos (/ Flae 1000000) 2 nachkomma)"m²"))
  (command "_.text" p_flae "" "" s_Flae)
(terpri)
  (setq p_umfa (getpoint "Einfügepunkt für Umfang"))
  (setq s_umfa (strcat "U = " (rtos (/ umfa 1000) 2 nachkomma)"m"))
  (command "_.text" p_umfa "" "" s_umfa)
  (terpri)
(setq p_text (getpoint "Einfügepunkt für Beschreibung"))
  (setq s_text (strcat _typ " | " _num))
  (command "_.text" p_text "" "" s_text)
(setvar "blipmode" BLIALT)
(setvar "cmdecho" CMDALT)
(setvar "OSMODE" OSMALT)
)

------------------
Gruß Holger

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

---

@ spider_dd

Hallo spider.
Super es funktioniert. Wir zeichnen in cm und die Ausgabe ist in m2 .
ICh habe es abgeändert mit meinen wenigen Kenntnissen in Lisp.
Jetzt bekomm ich es in m2 heraus.
So, da taucht noch eine wichtige Frage auf. Wir bekommen für Kleinprojekte immer mal wieder Pläne in unterschiedlichen Einheiten.
Da es Megga- Arbeit ist alles immer wieder zu bearbeiten kommt es vor das wir mal in mm, dann cm und evtl. auch noc m arbeiten. Eine fürchterliche Angelegenheit.
Jetzt die Frage. !!
Kann man die Flächenberechnung nicht noch so umstellen das eine Abfrage kommt ?
1. Arbeitsmasstab cm m...
2. Ausgabeeinhet m2 mm2 oder cm

Das wäre doch genial. Ich bekomm es so aber nicht hin.

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

@ holgerlab

Hi. Lies mal meinen Kommentar vorher. Das wäre toll wenn das damit auch geht. Zusätzlichh müsste man noch einen Layer wählen könne auf den das ganze geschrieben wird. Jeder ANwender arbeitet ja mit einer anderen Belegung.

Ach ja. Und wenns dann ganz anschaulich wäre mit einem schönen Fenster. Was wären denn die Anwender Glücklich.

"Ja ist denn scho Weihnachten"

Gruß Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hallo Carsten,

setze mal die folgenden Code-Fragmente an passender Stelle ins lisp

dieses sicherlich ziemlich weit vorn, vor Abfrage der Elemente

; Abfrage Einheiten und setzen Umrechnungsfaktor
; 1. alles Umrechnen auf m2
(setq zeichnen_einheit (getstring "Zeichnungseinheit angeben (m/cm/mm) "))
(if (= zeichnen_einheit "m")
    (setq faktor_1 1.0)
    (if (= zeichnen_einheit "cm")
        (setq faktor_1 (/ 1.0 10000.0))
        (setq faktor_1 (/ 1.0 1000000.0))
    )
)
; 2. alles Umrechnen von m2
(setq ausgabe_einheit (getstring "Ausgabeeinheit angeben (m2/cm2/mm2) "))
(if (= ausgabe_einheit "m2")
    (setq faktor_1 1.0)
    (if (= ausgabe_einheit "cm2")
        (setq faktor_1 10000.0)
        (setq faktor_1 1000000.0)
    )
)
(setq faktor (* faktor_1 faktor2))

das auch noch dort

; Ausgabelayer abfragen
(setq layer_ausgabe (getstring "Name des Datenausgabe-Layers "))

das folgende an Stelle der Zeilen
  (if (not (tblsearch "layer" "flaeche"))
    (command "_LAYER" "_M" "flaeche" "_C" "8" "" "")
    (command "CLAYER" "flaeche")
  )

; Ausgabelayer setzen
(command "layer" "ma" layer_ausgabe "")

oder in den genannten Zeilen "flaeche"  mit  layer_ausgabe  ersetzen

dann noch die zeilen

(setq flaech ...)
  (setq txt ...)

wie folgt ändern
(setq flaech (* flaech faktor)) ; Umrechnung von zeichnungs- auf ausgabeeinheit
(setq txt (strcat (rtos flaech 2 komst) " " ausgabe_einheit))

Ich hoffe es stimmt alles, habe gerade kein acad zu Hand um das zu testen. Es ist auch noch keine Prüfung hinsichtlich Fehleingabe enthalten, müßte jetzt auch erst mal in der Hilfe suchen.

Probiers mal aus

Viele Grüße
spider

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

---

Hallo Spider.

Also hab es versucht aber wirklich, ich krieg es nicht hin. Ich weiss auch nicht so recht was ich da einfüge. Meine Kenntnisse sind da bene was Lisp betrifft eher bescheiden.

Im Anhang meine geänderte Variante mit Berechnung vvon ZE = cm und Ausgabe in m2. Vielleicht kannst du es mal abändern , ich schaff es nicht.
Beachte das man vorher die Massgebenden Layer die berücksichtigt werden auswählen kann. Das find ich gut.
Vielleicht kannst du in diese Aufforderungszeile  ...Objekt/Umfang/Konfig  die Abfrage so einfügen
das die Werte behalten werden für Zeicheneinheit, Ausgabeeinheit, Layer wo der Text hinkommt.
Das wäre doch sinnvoller.
Kannst du das ergänzen ? das wäre super... :-)

Gruß Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hallo Carsten,

und wo ist der Anhang??

ich kanns mir ja mal ansehen, wird aber wahrscheinlich erst über wochenende.

Gruss
spider

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

---

fläche2_cm_m2.txt

Hallo spider.

Hier der Anhang.

Danke vorerst..

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Wenns nicht zu laden geht hier der Inhalt:

; Programm zur Flächenermittlung
; Das Programm ist Freeware -
; Der Autor (Ernst Dietrich) übernimmt daher keinerlei Haftungen.
; Die Benutzung erfolgt auf eigene Gefahr !
; 28.08.2003:  Es wurden kleinere Korrekturen vorgenommen
;
; ÄNDERUNGEN DURCH KODAT
; Nachkommastellen = 2
; Layer getauscht von flaech auf A_BB_TEXT_Raunflächen
;

(defun c:ff (/ pkt apkt p1 dist anfragetxt)
  (command "_.UNDO" "_END")
  (command "_.UNDO" "_GROUP")
  (setvar "PLINETYPE" 2)
  (setq olderr *error*)
  (setq *error* ederr)
  (setq vorlay (getvar "CLAYER"))
  (if (not konf)
    (flkonfig)
  )
  (if (not komst)
    (rundg)
  )
  (setq pkt T)
  (eingab)
  (while pkt
    (if umf
      (progn
        (if (not (= pkt "Objekt"))
          (flsolid)
        )
        (setq anfragetxt (strcat "\nFläche = " (rtos A_BB_TEXT_Raunflächen) " / " (rtos A_BB_TEXT_Raunflächen 2 komst)
                                        " m² - Beschriften: Nein=Enter/<<Textmitte>> "))
        (if (= 'LIST (type (setq einfpkt (getpoint anfragetxt))))
          (beschr)
        )
        (if (= pkt "Objekt")
          (progn
            (redraw umf 4)
            (command "_.ERASE" sol "")
          )
          (command "_.ERASE" umf sol "")
        )
      )
    )
    (eingab)
  )
  (command "CLAYER" vorlay)
  (command "_.UNDO" "_END")
  (princ)
)
;-------------------------------------------------------------------------
(defun eingab ()  ;Eingabe einer Option oder Punkt in der Fläche
  (osm0)
  (initget 128 "Objekt Umfahrung Konfig Rundg")
  (setq pkt (getpoint "\nObjekt/Umfahrung/Konfig/Rundung/<<Punkt für automatisch:>> "))
  (osmz)
  (cond
    ((= pkt "Objekt") (objekt-berech))
    ((= pkt "Umfahrung") (umf-berech))
    ((= pkt "Konfig")
      (flkonfig)
      (eingab)
    )
    ((= pkt "Rundg")
      (rundg)
      (eingab)
    )
    (pkt (pkt-berech))
  )
)
;-------------------------------------------------------------------------
(defun rundg () 
  (if (not (setq komst (getint "\nFlächentext runden auf wieviele Kommastellen: <2> ")))
    (setq komst 2)
  )
)
;-------------------------------------------------------------------------
(defun objekt-berech (/ obj)
  (setq obj (entsel "\nPolylinie oder Kreis wählen: "))
  (setq umf (car obj))
  (redraw umf 3)
  (command "_.AREA" "O" obj)
)
;-------------------------------------------------------------------------
(defun umf-berech (/ anfragetxt) ;Umfahrung
  (setq pkt (setq p1 (getpoint "\nErster Punkt: ")))
  (command "_PLINE" p1)
  (while (setq pkt (getpoint pkt "\nNächster Punkt: <Schliessen> "))
    (osm0)
    (command pkt)
    (if pkt
      (progn
        (setq dist (distance p1 pkt))
        (princ (strcat "\nEntfernung= "(rtos dist 2 2) " m"))
        (setq p1 pkt)
      )
    )
    (osmz)
  )
  (command "S")
  (setq umf (entlast))
  (flsolid)
  (command "_.AREA" "O" umf)
  (setq A_BB_TEXT_Raunflächen (getvar "AREA"))
  (setq anfragetxt (strcat "\nFläche = " (rtos A_BB_TEXT_Raunflächen) " / " (rtos A_BB_TEXT_Raunflächen 2 komst) " m² - Beschriften: Nein=Enter / <<Textmitte>> "))
  (if (= 'LIST (type (setq einfpkt (getpoint anfragetxt))))
    (beschr)
  )
  (command "_.ERASE" umf sol "")
  (eingab)
)
;----------------------------------------------------------------------
(defun pkt-berech (/ lastnach lastvor)
  (load "c:/temp/VORAUSW")
  (vorauswahl)
  (command "_LAYER" "_T" "0" "")
  (command "CLAYER" 0)
  (setq lastvor (entlast))
  (command "_boundary" "O" "U" "N" aws "" "X" pkt "")
  (setq lastnach (entlast))
  (if (equal lastvor lastnach)
    (progn
      (setq umf nil)
      (setq A_BB_TEXT_Raunflächen "")
      (alert "Keine gültige Umgrenzung gefunden")
    )
    (progn
      (setq umf (entlast))
      (redraw umf 3)
      (command "_.AREA" "O" umf)
      (setq A_BB_TEXT_Raunflächen (getvar "AREA"))
    )
  )
)
;----------------------------------------------------------------------
(defun flsolid (/ counter lay)        ;zeigt die gefundene Fläche durch ein temporäres Solid an
  (if (not aws)                        ; wenn Auswahlsatz "aws" nicht existiert
    (progn                               
      (setq aws (ssadd))            ; erstelle den Auswahlsatz "aws" neu und
      (ssadd (entlast) aws)        ; füge das zuletzt erstellte Objekt hinzu.
    )
  )
  (command "REGENAUTO" 0)
  (setq lay "flsolid")
  (if (tblsearch "layer" lay)
    (command "_layer" "_s" lay "")
    (command "_layer" "m" lay "fa" "251" ""  "")
  )
  (command "_HATCH" "solid" umf "")
  (setq sol (entlast))
  (command "_draworder" "L" "" "N" (ssname aws 0))        ;das letzte Objekt wird unter die erste Grenze gelegt.
  (entupd sol)
  (setq counter 0)
  (repeat (sslength aws)
    (entupd (ssname aws counter))
    (setq counter (1+ counter))
  )
  (command "REGENAUTO" 1)
  (command "CLAYER" vorlay)
)
;----------------------------------------------------------------------
(defun beschr (/ txt)
;  (command "_.ERASE" umf sol "")
  (if (not (tblsearch "layer" "A_BB_TEXT_Raunflächene"))
    (command "_LAYER" "_M" "A_BB_TEXT_Raunflächen" "_C" "82" "" "")
    (command "CLAYER" "A_BB_TEXT_Raunflächen")
  )
;  (setq txt (strcat (rtos A_BB_TEXT_Raunflächen 2 komst) " m2"))
  (setq A_BB_TEXT_Raunflächen (* A_BB_TEXT_Raunflächen 0.0001)) ; Umrechnung cm2 in m2
  (setq txt (strcat (rtos A_BB_TEXT_Raunflächen 2 komst) " m2"))

  (command "_.TEXT" "s" "Standard" "_J" "MZ" einfpkt 20 (+ (vt) 0) txt)  ;den Wert 0  entsprechend korrigieren

)
;----------------------------------------------------------------------
(defun ederr (s)
  (print s)
  (command "_.ERASE" umf sol "")
  (setq *error* olderr)
)
;----------------------------------------------------------------------
;diese Funktion fragt um Objekte, deren Layer wiederum als Filter für die Flächenberechnung
;verwendet werden. Mit den Layernamen wird das LSP-File VORAUSW erzeugt, welches dann
;die Objekte zur Flächenberechnung auswählt.

(defun flkonfig ()
  (initget 128 "Wie")
  (setq obj (nentsel "\nWelche Layer - Objekte anklicken/Wie bisher: <Voreinstellung> "))
  (cond
    ((= obj "Wie") (princ "\nBisherige Layer werden verwendet"))
    ((not obj) (stdard))        ;Layer laut Voreinstellung
    (obj (neuausw))
  )
  (setq konf T)
)
;----------------------------------------------------------------------
(defun neuausw (/ laynam lspfile)  ;Layer anklicken
  (setq lspfile (open "c:\\temp\\vorausw.lsp" "w"))
  (princ "(defun vorauswahl ()\n" lspfile)
  (princ "  (setq aws (ssget \"X\"\n" lspfile)
  (princ "    '((-4 . \"<or\")" lspfile)
  (while obj
    (princ "\n      " lspfile)
    (prin1 (cons 8 (setq laynam (cdr (assoc 8 (entget (car obj)))))) lspfile)
    (print laynam)
    (setq obj (nentsel "\nWelche Layer berücksichtigen - Objekte anklicken: "))  )
  (princ "\n    (-4 . \"or>\"))" lspfile)
  (princ "\n  ))" lspfile)
  (princ "\n)" lspfile)
  (close lspfile)
)
;----------------------------------------------------------------------
(defun stdard (/ lspfile)  ;Default-Layer
  (setq lspfile (open "c:\\temp\\vorausw.lsp" "w"))
  (princ "(defun vorauswahl ()\n" lspfile)
  (princ "  (setq aws (ssget \"X\"\n" lspfile)
  (princ "    '((-4 . \"<or\")" lspfile)
 
; hier können die Layer für die Voreinstellung eingetragen werden - jetzt nur "0", Layer "abc" und "def" vorbereitet
  (princ "\n      " lspfile) (prin1 (cons 8 "0") lspfile)
;  (princ "\n      " lspfile) (prin1 (cons 8 "abc") lspfile)
;  (princ "\n      " lspfile) (prin1 (cons 8 "def") lspfile)

  (princ "\n    (-4 . \"or>\"))" lspfile)
  (princ "\n  ))" lspfile)
  (princ "\n)" lspfile)
  (close lspfile)
)
;----------------------------------------------------------------------
(defun osm0 ()
  (setq osm (getvar "osmode"))
  (setvar "OSMODE" 0)
)
;------------------------------------------------------------------------------
(defun osmz ()
  (setvar "OSMODE" osm)
)
;----------------------------------------------------------------------
(defun vt ()
  (cvunit (getvar "viewtwist") "radiant" "neugrad")
)

;XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

(princ "\nStart mit  ff  ")

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Zitat:

---

Original erstellt von Kodat:
@ holgerlab

Hi. Lies mal meinen Kommentar vorher. Das wäre toll wenn das damit auch geht. Zusätzlichh müsste man noch einen Layer wählen könne auf den das ganze geschrieben wird. Jeder ANwender arbeitet ja mit einer anderen Belegung.

Ach ja. Und wenns dann ganz anschaulich wäre mit einem schönen Fenster. Was wären denn die Anwender Glücklich.

"Ja ist denn scho Weihnachten"

Gruß Carsten

---

Hallo Carsten,
ich bin ganz stoltz auf mich, dass ich mein erstes Lisp-Programm sinnvoll anpassen konnte. Aber Fenster und Layer wählen vielleicht noch den Massstab wählen  - - ich hätte da auch noch Ideen zu verbessern z.B. Ausgabe in einen Block mit Attributen -> dann könnte man die Flächen einfacher auslesen --- da brauche ich noch ein paar Jahre übung ;-)

------------------
Gruß Holger

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

---

flaeche_neu.txt

Hallo Carsten,

nach einer Weile Orientierung im Prog. habe ich die Abfragen mal eingebaut. Abfragen erfolgen bei Programmaufruf, dort passten sie IMHO am besten.
Kleiner Tipp am Rande, es ist vielleicht günstiger für Variablen- und Layerbezeichnungen kein Umlaute zu verwenden, dass kann manchmal schief gehen.

Probiers aus!

Gruss
spider

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

---

@ holgerlab

Klar du hast recht. jeder möchte gern Verbesserungen. Und ich muß hier auch mal ein ganz ---- großes Lob --- aussprechen an all die jenigen die so fit sind in Lisp und VBA etc. Und dann auch noch anderen damit helfen. SUPER SUPER.
Ich kann leider keine Lips programieren und schreiben.

@ spider

Super spider es klappt. Hab es ein paar mal ausprobiert , verschieden Komma, ander ZE, andere Ausgabeeinheit-- hab nichts feststellen könne was falsch ausgegeben wird.
Etwas irritierend ist zwar die FLäche vor setzetn des Textes, da wird wohl noch die alte Einstellung ausgegeben.
Wenn man den Text aber absetzt ist es richtig.
Kannst Du das vieleicht noch anpassen.
Wenn nicht, dann gehts auch so.
Super spider , nochmals vielen Dank und die Units geb ich DIr schon mal......

Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

flaeche_neu.txt

Hallo Carsten,

das mit der Flächenanzeige hatte ich auch schon gesehen, hatte die Umrechnung erst unmittelbar vor Ausgabe gemacht. Hab die Zeile zur Umrechnung jetzt vorgezogen, gleich nach die Flächenermittlung.
Frohes Schaffen

spider

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

---

@ spider

Geht nicht , immer noch so komisch.
Aber lass mal gut sein. Is bald Wochenende.

Gruß Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

flaeche_neu.txt

Hallo Carsten,

die letzte Version war eher eine Verschlimmbesserung.
Ich habe die vorhergehende wieder hergestellt (Umrechnung auf Zieleinheit erst kurz vor Textausgabe). Bei der Anzeige der Werte in Befehlszeile vor Absetzen wird jetzt die Zeicheneinheit angegeben.
Es sind noch ein paar Dinge in dem Prog. die ich nicht so ganz durchschaue bzw. die bei mir nicht so recht gingen, deshalb nun wieder dieser Weg.

Schönes WE und Frohes Schaffen

spider

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

---

Hallo spider.

Nochmal eine Frage: Kannst Du einen Layer als Voreinstellung integrieren so das er als erstes nicht angegeben werden muss.
Wenn dann ein anderer Layer gewünscht ist kann er dann neu gewählt werden.

Gruß Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hallo Carsten,

die Layerabfrage wird im Programmlauf einmal nach Start des Progs abgefragt.

ersetz mal

  (setq layer_ausgabe (getstring "Name des Datenausgabe-Layers "))

mit
  (setq layer_ausgabe (getstring "Name des Datenausgabe-Layers "))
  (if (= "" layer_ausgabe)
      (setq layer_ausgabe (getvar "clayer"))
  )

dann wird bei Eingabe keines Namens der aktuelle Layer als Ausgabelayer verwendet.

Gruß
spider

[Diese Nachricht wurde von spider_dd am 22. Mrz. 2005 editiert.]

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

---

flaeche3.lsp.txt

Hallo spider.
Es hat funktioniert. Aber..
Schau dir jetzt nochmal das Lisp an. Ich glaub da hab ich was durcheinander gebracht mit dem Layer A_BB_Text_Raumflächen .
Standardmässig soll der Text dorthingeschrieben werden. Wenn nichtkommt jetzt die neue Eingabe von Dir.
Ist das jetzt noch so ok.
Wenn du Lust und Zeithast Prüf das doch nochmal damit es sauber programmiert ist.Sieht mir irgendwie komisch aus.
Vielen Dank.

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hallo Carsten,

Sorry ich verstehe beim besten Willen nicht wass du meinst,
kannst du mal versuchen, klar und eindeutig zu sagen, wass passiert und was nicht?

Gruss
spider

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

---

Hallo spider, vielleicht hab ich mich echt zu blöd ausgedrückt.
Das Lisp funktioniert. Ich hatte aber dort selber etwas verändert
siehe Lisp: mit dem Hinweis --->
Layer getauscht von flaech auf A_BB_TEXT_Raunflächen
---------
Was ich da genau gemacht habe , keine Ahnung. Nach deiner Erweiterung ist ja auch alles ok.
Aber ist es durch meine Änderung denn sauber Programmiert ?
Wie gesagt, es geht ja.
Aber eine Überprüfung wäre doch nicht schlecht.
Mehr meinte ich gar nicht.
Entweder höre ich jetzt noch etwas von dir oder wir lassen es einfach so stehen, weil es ja geht.

Gruß Carsten und Danke.

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

Hallo Carsten,

Im Lisp ist nirgends ein Layer "A_BB_TEXT_Raunfläche" zu finden.

Deine Variable A_BB_TEXT_Raunfläche enthält keine Layerbezeichnung, sondern den Werte der aktuellen Fläche, siehe
(setq A_BB_TEXT_Raunflächen (getvar "AREA"))

Generell sind Bezeichnungen (so auch Variablennamen) mit Umlauten als kritisch anzusehen, das kann auch mal schiefgehen.

Und wemm alles läuft, wie es soll, dann ist doch alles OK (und offensichtlich richtig :-) )

Also Frohes Schaffen noch
Gruss
spider

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

---

Hallo spider.
Da sieht man mal was mann alles für ein Unfug schreiben kann.

Ok ich lass es jetzt so und danke nochmal.

Gruß Carsten

------------------
Vielen Dank für jeden Hinweis.
Carsten

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

---

hallo, bin interessiert an dieser lsp, kann mir bitte jemand eine gültige
version für die ermittlung in m2 als zip zukommen lassen oder hier reinstellen, bei den vielen ergänzungen weis ich nicht mehr was nun die volltsändige version ist, aber jetzt meine bitte:
habe versucht mit ;; den umpfang auszukommentieren- ist mir leider nicht gelungen, ich brauche eigentlich nur Pos und Fläche in der datei und als textdatei,
Frage:
1. rechnet diese lsp eigentlich auch eine fläche mit Z-wert, also im 3D raum,
2. wie komme ich an die umringspunkte (koordinaten) heran
gruß bauvermesser

------------------
Gruß vom Bauvermesser;

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

---

hallo, bin interessiert an dieser lsp, kann mir bitte jemand eine gültige
version für die ermittlung in m2 als zip zukommen lassen oder hier reinstellen, bei den vielen ergänzungen weis ich nicht mehr was nun die volltsändige version ist, aber jetzt meine bitte:
habe versucht mit ;; den umpfang auszukommentieren- ist mir leider nicht gelungen, ich brauche eigentlich nur Pos und Fläche in der datei und als textdatei,
Frage:
1. rechnet diese lsp eigentlich auch eine fläche mit Z-wert, also im 3D raum,
2. wie komme ich an die umringspunkte einer berechneten fläche heran (koordinaten)und kann sie abspeichern
gruß bauvermesser

------------------
Gruß vom Bauvermesser;

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

---

FlaechenStempel.zip

hola, freunde der klammern,

bin mal so frei, und stelle ein bisschen code zur verfügung (anhang).

um allen buu-rufen vorzubeugen:
entschuldigung, sollte ich das thema verfehlt haben (habe "Flaechenstempel" gelesen, und einfach meinen code eingestellt).
ich denke schriftfelder gibt's erst ab acad2005 od. 2006 dh. für frühere versionen wird das ding nicht laufen.

habt spass
alex

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