Flächenberechnung mit LISP

Fragen und Anmerkungen zu den Lispprogrammen von CADwiesel
Antworten
Balou_2002
Newbie
Beiträge: 3
Registriert: Di 8. Mär 2005, 11:05

Flächenberechnung mit LISP

Beitrag von Balou_2002 » Di 21. Feb 2006, 11:22

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

Benutzeravatar
CADwiesel
Administrator
Beiträge: 488
Registriert: Mo 11. Jun 2018, 13:07
Kontaktdaten:

Beitrag von CADwiesel » Di 21. Feb 2006, 15:51

Ich vermute mal es ist eine feste Texthöhe eingestellt und das Programm ist aber auf diese Einstellung nicht angepasst.
Ich gugge mal...
Gruß
BildCADwiesel
Besucht uns im CHAT

Benutzeravatar
CADwiesel
Administrator
Beiträge: 488
Registriert: Mo 11. Jun 2018, 13:07
Kontaktdaten:

Beitrag von CADwiesel » Di 21. Feb 2006, 16:00

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)
Gruß
BildCADwiesel
Besucht uns im CHAT

Balou_2002
Newbie
Beiträge: 3
Registriert: Di 8. Mär 2005, 11:05

DANKE!

Beitrag von Balou_2002 » Di 21. Feb 2006, 16:07

Danke - funktioniert!

Gruß Marco

Benutzeravatar
CADwiesel
Administrator
Beiträge: 488
Registriert: Mo 11. Jun 2018, 13:07
Kontaktdaten:

Beitrag von CADwiesel » Di 21. Feb 2006, 16:08

...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
Gruß
BildCADwiesel
Besucht uns im CHAT

Balou_2002
Newbie
Beiträge: 3
Registriert: Di 8. Mär 2005, 11:05

Flächenermittlung mit Maß

Beitrag von Balou_2002 » Di 7. Mär 2006, 15:26

Hallo!

Kann man die Lisp soweit erweitern, dass eventuell hinter der Zahl die Qadratmeter stehen, oder mit einem Faktor auch Hektar etc!?

Gruß Marco

Benutzeravatar
CADwiesel
Administrator
Beiträge: 488
Registriert: Mo 11. Jun 2018, 13:07
Kontaktdaten:

Beitrag von CADwiesel » Mi 8. Mär 2006, 07:49

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:

Code: Alles auswählen

(CONS 1 (rtos (* 1000(getvar "area")) 2 2)) 
oder so:

Code: Alles auswählen

(CONS 1 (strcat "Gesamtfläche: " (rtos (* 1000 gesamt) 2 2) "Ha"))
Gruß
BildCADwiesel
Besucht uns im CHAT

Antworten