Flächenberechnung mit LISP
-
- Newbie
- Beiträge: 3
- Registriert: Di 8. Mär 2005, 11:05
Flächenberechnung mit LISP
Hallo!
Habe mir bei CADWIESEL die LISP >Fla-neu< und >Md_fla< herunter geladen und in ADT eingebunden/eingeladen.
Damit soll man von Polilinien Fläächen ermitteln können und die Fläche wird dann in die Zeichnung geschrieben.
Klicke ich die Fläche an zeigt e mir die Ermittlung korrekt an. Lege ich den Einfügepunkt für die Fläche fest, schreibt er als Text nur eine Null (0). Als Meldung erscheint dann in der Eingabezeile:
0
*****Gesamtfläche: 192.32 qm
Einfügepunkt:Unbekannter Befehl "GESAMTFLÄCHE: 192.32QM". Drücken Sie F1-Taste für Hilfe.
Kann mir jemand sagen woran das liegen könnte und wie man den Fehler behebt!?
Gruß Marco
Habe mir bei CADWIESEL die LISP >Fla-neu< und >Md_fla< herunter geladen und in ADT eingebunden/eingeladen.
Damit soll man von Polilinien Fläächen ermitteln können und die Fläche wird dann in die Zeichnung geschrieben.
Klicke ich die Fläche an zeigt e mir die Ermittlung korrekt an. Lege ich den Einfügepunkt für die Fläche fest, schreibt er als Text nur eine Null (0). Als Meldung erscheint dann in der Eingabezeile:
0
*****Gesamtfläche: 192.32 qm
Einfügepunkt:Unbekannter Befehl "GESAMTFLÄCHE: 192.32QM". Drücken Sie F1-Taste für Hilfe.
Kann mir jemand sagen woran das liegen könnte und wie man den Fehler behebt!?
Gruß Marco
- CADwiesel
- Administrator
- Beiträge: 488
- Registriert: Mo 11. Jun 2018, 13:07
- Kontaktdaten:
- CADwiesel
- Administrator
- Beiträge: 488
- Registriert: Mo 11. Jun 2018, 13:07
- Kontaktdaten:
Hier mal das 1. Prog:
Code: Alles auswählen
(defun c:fla-neu (/ dd tt t_2 inpkt)
(setq tt nil
dd nil
t_2 nil
inpkt nil
) ;_ end of setq
(setq tt (car (nentsel "Raumpolygon zeigen:")))
(cond
((and (or (= (cdr (assoc 70 (entget tt))) 129)
(= (cdr (assoc 70 (entget tt))) 1)
) ;_ end of or
(= (cdr (assoc 0 (entget tt))) "LWPOLYLINE")
) ;_ end of and
(redraw tt 3)
(terpri)
(princ "Abzugspolygon(e) zeigen:")
(if (setq dd (ssget '((-4 . "<OR")
(-4 . "<AND")
(0 . "LWPOLYLINE")
(-4 . "<OR")
(70 . 129)
(70 . 1)
(-4 . "OR>")
(-4 . "AND>")
(-4 . "<AND")
(0 . "POLYLINE")
(-4 . "<OR")
(70 . 129)
(70 . 1)
(-4 . "OR>")
(-4 . "AND>")
(-4 . "OR>")
)
) ;_ end of ssget
) ;_ end of setq
(progn
(terpri)
(setq md_zaehler 0)
(command "_.area" "a" "_o")
(command tt "")
(command "s" "_o")
(repeat
(sslength dd)
(setq t_2 (ssname dd 0))
(command t_2)
(setq dd (ssdel t_2 dd))
) ;ende rep
(command "" "")
(setq inpkt (getpoint "Einfügepunkt für Flächenwerte:"))
(entmake (LIST
'(0 . "TEXT")
(cons 8 (getvar "clayer"))
(CONS 10 inpkt)
'(40 . 0.35)
'(50 . 0.0)
(CONS 1 (rtos (getvar "area") 2 2))
) ;_ ende von LIST
)
) ;progn
(progn
(command "_.area" "_o")
(command tt)
(setq inpkt (getpoint "Einfügepunkt für Flächenwerte:"))
(entmake (LIST
'(0 . "TEXT")
(cons 8 (getvar "clayer"))
(CONS 10 inpkt)
'(40 . 0.35)
'(50 . 0.0)
(CONS 1 (rtos (getvar "area") 2 2))
) ;_ ende von LIST
)
) ;progn
) ;if
)
((null (PRINC "Nichts oder Falsch gewählt."))
)
) ;_ end of cond
(command "_regen")
) ;defun
(princ "\nProgramm ausführen mit >FLA-NEU<")
(princ)
-
- Newbie
- Beiträge: 3
- Registriert: Di 8. Mär 2005, 11:05
DANKE!
Danke - funktioniert!
Gruß Marco
Gruß Marco
- CADwiesel
- Administrator
- Beiträge: 488
- Registriert: Mo 11. Jun 2018, 13:07
- Kontaktdaten:
...und hier die andere
Code: Alles auswählen
(defun c:md_fla (/ t_2 Ss start md_zaehler gesamt md_in einzel)
(setq Ss (ssget '((0 . "*POLYLINE"))))
(setq md_zaehler 0)
(setq gesamt 0)
(if (not Ss)
(princ (strcat "\nkeine Polylinien gefunden."))
(progn
(while (setq t_2 (ssname Ss 0))
(setq md_in (cdr (assoc 10 (entget t_2))))
(setq startp md_in)
(command "_.area" "_o")
(command t_2)
(entmake (LIST
'(0 . "TEXT")
(cons 8 (getvar "clayer"))
(CONS 10 startp)
'(40 . 0.35)
'(50 . 0.0)
(CONS 1 (rtos (getvar "area") 2 2))
) ;_ ende von LIST
) ;_ end of entmake
(setq Ss (ssdel t_2 Ss))
(princ md_zaehler)
(setq md_zaehler (1+ md_zaehler))
(setq einzel (atof (rtos (getvar "area") 2 2)))
(setq gesamt (+ gesamt einzel))
) ;_ end of while
(princ "\n")
(princ
(strcat "\n*****Gesamtfläche: " (rtos gesamt 2 2) " qm")
) ;_ end of princ
(terpri)
(setq start (getpoint "Einfügepunkt:"))
(entmake
(LIST
'(0 . "TEXT")
(cons 8 (getvar "clayer"))
(CONS 10 start)
'(40 . 0.35)
'(50 . 0.0)
(CONS 1 (strcat "Gesamtfläche: " (rtos gesamt 2 2) "qm"))
) ;_ ende von LIST
) ;_ end of entmake
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun
-
- Newbie
- Beiträge: 3
- Registriert: Di 8. Mär 2005, 11:05
Flächenermittlung mit Maß
Hallo!
Kann man die Lisp soweit erweitern, dass eventuell hinter der Zahl die Qadratmeter stehen, oder mit einem Faktor auch Hektar etc!?
Gruß Marco
Kann man die Lisp soweit erweitern, dass eventuell hinter der Zahl die Qadratmeter stehen, oder mit einem Faktor auch Hektar etc!?
Gruß Marco
- CADwiesel
- Administrator
- Beiträge: 488
- Registriert: Mo 11. Jun 2018, 13:07
- Kontaktdaten:
klar geht das im 2. Lisp ist doch schon qm drin.
du brauchst duch nur diese Zeile anzupassen, indem du den Wert vorher mit dem Umrechnungsfaktor multiplizierst
so:
oder so:
du brauchst duch nur diese Zeile anzupassen, indem du den Wert vorher mit dem Umrechnungsfaktor multiplizierst
so:
Code: Alles auswählen
(CONS 1 (rtos (* 1000(getvar "area")) 2 2))
Code: Alles auswählen
(CONS 1 (strcat "Gesamtfläche: " (rtos (* 1000 gesamt) 2 2) "Ha"))