Area selected hatch - BIJKOMENDE VRAAG

[Bart Dheere]

Vond een lisp terug voor het achterhalen van de totale lengte van lijnen.
Kan dat voor geselecteerde hatches ook?


TLEN.LSP - Total LENgth of selected objects
(c) 1998 Tee Square Graphics

|;

(defun C:TLEN (/ ss tl n ent itm obj l)
  (setq ss (ssget)
        tl 0
        n (1- (sslength ss)))
  (while (>= n 0)
    (setq ent (entget (setq itm (ssname ss n)))
          obj (cdr (assoc 0 ent))
          l (cond
              ((= obj "LINE")
                (distance (cdr (assoc 10 ent))(cdr (assoc 11 ent))))
              ((= obj "ARC")
                (* (cdr (assoc 40 ent))
                   (if (minusp (setq l (- (cdr (assoc 51 ent))
                                          (cdr (assoc 50 ent)))))
                     (+ pi pi l) l)))
              ((or (= obj "CIRCLE")(= obj "SPLINE")(= obj "POLYLINE")
                   (= obj "LWPOLYLINE")(= obj "ELLIPSE"))
                (command "_.area" "_o" itm)
                (getvar "perimeter"))
              (T 0))
          tl (+ tl l)
          n (1- n)))
  (alert (strcat "Total length of selected objects is " (rtos tl)))
  (princ)
)

[Bart Dheere]

De oppervlakte van geselecteerde hatches zijn te zien in properties.
Ook met onderstaande routine lukt dat.

Som van geselecteerde areas.

(defun c:sarea (/ sset i area obj)
(if (>= (atof (substr (getvar "acadver") 1 4)) 16.2)
(progn
(prompt "\nSelect hatches: ")
(if (setq sset (ssget '((0 . "hatch"))))
(progn
(setq
i (1- (sslength sset))
area 0)
(while (>= i 0)
(setq
obj (vlax-ename->vla-object (ssname sset i))
area (+ area (vla-get-area obj)))
(setq i (1- i)))
(alert
(strcat
"\nTotal area = "
(if (or (= (getvar "lunits") 3) (= (getvar "lunits") 4))
(strcat
(rtos area 2)
" sq. in. ("
(rtos (/ area 144) 2)
" sq. ft.)")
(rtos area))))))))
(princ))

[Adrianus]

Beste Bart,
Ik heb  zojuist je lisp getest en deze werkt op zich goed. Is het echter ook mogelijk de uitgerekende waarde in m2 te verkrijgen?

Met vriendelijke groet,
Adrianus

[Bart Dheere]

Goedemorgen Adrianus,

Ik teken mijn plannen in meter-eenheden. Dus de weergeven eenheid bij uit uitvoeren van deze routine is de gebruikte eenheid... veronderstel ik.

Alleen ware het mss handig om idd de eenheid m² in de messagebox te voorschijn zien te toveren.
Daar ben ik niet in thuis.

mss oproep aan forumcollega's.

Groeten,
Bart

[EddyBeerke]

Ook hier weer de waarschuwing om niet een oppervlakte uit een hatch te gebruiken voor hoeveelheden.
Hier kunnen fouten mee ontstaan.
Soms heeft een hatch zelfs GEEN area!, hoe ga je daar mee om???
Er zijn verschillende topics over dit onderwerp te vinden op het web...
Een gewaarschuwd mens...

[roy_043]

Pas ook op met zelfkruisende polylines.

[Bart Dheere]

Eigenlijk is de area van de geselecteerde hatches te zien in de properties. Als, na selectie van de hatches, deze  niet zichtbaar is, zit je met een probleemje. Deze kan dan een hatch zijn van kruisende polylijnen. Dan start de zoektocht.

[roy_043]

Deze geeft ook het totaal in m2 (en waarschuwt bij een problematische hatch):

Code Selecteer Uitklappen

(defun _Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun _Sys_Apply (expr varLst / ret)
  (if (not (vl-catch-all-error-p (setq ret (vl-catch-all-apply expr varLst))))
    ret
  )
)

(defun c:TotArea ( / lst ss tot)
  (if (setq ss (ssget '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,LWPOLYLINE,POLYLINE,REGION,SPLINE"))))
    (progn
      (setq lst
        (mapcar
          '(lambda (obj / typ)
            (setq typ (vla-get-objectname obj))
            (cond
              (
                (vl-position
                  typ
                  '("AcDb2dPolyline" "AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbPolyline" "AcDbRegion" "AcDbSpline")
                )
                (vla-get-area obj)
              )
              ( (= typ "AcDbHatch") ; Special case: Hatch with self-crossing boundary.
                (cond
                  ( (_Sys_Apply 'vla-get-area (list obj))
                  )
                  ( T
                    0.0
                  )
                )
              )
              (
                (and
                  (= typ "AcDb3dPolyline")
                  (vlax-curve-isplanar obj)
                )
                (vlax-curve-getarea obj)
              )
              ( T
                0.0
              )
            )
          )
          (mapcar 'vlax-ename->vla-object (_Conv_Pickset_To_EnameList ss))
        )
      )
      (setq tot (apply '+ lst))
      (cond
        ( (vl-some 'zerop lst)
          (alert
            (strcat
              "Error:"
              "\nThe area of some objects could not be determined"
            )
          )
        )
        ( (= (getvar 'insunits) 1) ; 1=Inches.
          (alert
            (strcat
              "Total area:"
              "\n" (rtos tot 2) " sq in"
              "\n" (rtos (/ tot 144.0) 2) " sq ft"
            )
          )
        )
        ( (= (getvar 'insunits) 2) ; 2=Feet
          (alert
            (strcat
              "Total area:"
              "\n" (rtos tot 2) " sq ft"
              "\n" (rtos (/ tot 27878400.0) 2) " sq mi"
            )
          )
        )
        ( (= (getvar 'insunits) 4) ; 4=Milimeters.
          (alert
            (strcat
              "Total area:"
              "\n" (rtos tot 2) " mm2"
              "\n" (rtos (/ tot 1000000.0) 2) " m2"
            )
          )
        )
        ( (= (getvar 'insunits) 5) ; 5=Centimeters.
          (alert
            (strcat
              "Total area:"
              "\n" (rtos tot 2) " cm2"
              "\n" (rtos (/ tot 10000.0) 2) " m2"
            )
          )
        )
        ( T
          (alert
            (strcat
              "Total area:"
              "\n" (rtos tot 2)
            )
          )
        )
      )
    )
  )
  (princ)
)

[Adrianus]

  Dank je wel Roy. Hij werkt perfect. 

Met vriendelijke groet,
Adrianus.