CADsite forum

Hallo

Is er in autocad een functie die kan uitreken hoeveel vierkanten meters iets is.  Ook als de tuin niet recht loopt en rare hoeken heeft.

Citaat van: dirkvijverberg op wo 31 05 2006, 20:29:16
Hallo

Is er in autocad een functie die kan uitreken hoeveel vierkanten meters iets is.  Ook als de tuin niet recht loopt en rare hoeken heeft.

Je kunt er een polyline van maken en het opvragen met de <properties> dialoogbox, of je vraagt het op met <area> onder <tools-inquiry> AREA.

Guus

en als je een recentere autocad hebt (ik dacht vanaf 2006); kan je ook een hatch toepassen.
als je dan bij properties kijkt, zie je de area van de hatch.
als je meerdere hatches selecteerd kan je zelfs de cummulative area (=som van oppervlaktes) zien in de properties palette.

deze methode is veel sneller als het ongelofelijk onregelmatige vlakken zijn, maar ze moeten wel "gesloten" zijn, zodat je kan hatchen....

Zie topic:
http://www.cadsite.be/smf/index.php/topic,1208.0.html

Of de volgende lisp routine:

;Oppervlakte - plaatst tekst met oppervlakte van object
;Geschreven door Olivier Hautekeete
;
------------------
| Hoofdprogramma |
--------------------------------------------------------------
(defun c:Opp ()
(variables1)
(vl-load-com)
(setq oAcad (vlax-get-acad-object)
oDoc (vla-get-activedocument oAcad)
EntNm (vlax-Ename->vla-Object (car (entsel "\nSelekteer een polyline")))
EntAre (vla-get-area EntNm)
opp (strcat "Opp: " (rtos EntAre 2 2) " m2"))
(plaats_text)
(variables2)
)
--------------------------------------------------------------
| Variables1
--------------------------------------------------------------
(defun variables1 ()
(setq osmo (getvar "osmode"))
(setq cmd (getvar "cmdecho"))
(setq fil (getvar "filedia"))
(setq diz (getvar "dimzin"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setvar "filedia" 0)
(setvar "dimzin" 2)
)
--------------------------------------------------------------
| Variables2
--------------------------------------------------------------
(defun variables2 ()
(setvar "osmode" osmo)
(setvar "cmdecho" cmd)
(setvar "filedia" fil)
(setvar "dimzin" diz)
)
--------------------------------------------------------------
(defun plaats_text ()
(setq p (getpoint "\nGeef de plaats aan voor de oppervlakte... "))
(entmake (list '(0 . "TEXT") ;type entiteit
(cons 10 p) ;tekst invoegpunt
'(40 . 0.5) ;teksthoogte                             
(cons 1 opp) ;de tekst zelf
)
)
)
--------------------------------------------------------------
| Lisp-melding
--------------------------------------------------------------
(princ "\nCopyright (C) Hautekeete Olivier - augustus 2005.")(princ)
(princ "\nStart het commando met 'OPP'.")(princ)
--------------------------------------------------------------


Groeten,

Reimer

CiteerJo-king
en als je een recentere autocad hebt (ik dacht vanaf 2006); kan je ook een hatch toepassen.
als je dan bij properties kijkt, zie je de area van de hatch.
als je meerdere hatches selecteerd kan je zelfs de cummulative area (=som van oppervlaktes) zien in de properties palette.

Ik was even het berichtje aan het lezen maar deze wist ik nog niet bedankt!

Groeten Simon

Hier nog eentje....


(defun c:AreaReact (/ Sel EntData PolyObj TextObj ReactList Pos TextSel)

;|  Adds a presistant reactor to a polyline object that
    updates a selected text object to the polylines area
    in square feet.  You will have to have the subs loaded
    in everydrawing for it to work, so that it know what
    to do with the reactor, because it is saved with the
    drawing.  Saves the association between the text
    and the polyline in the extension dictionary of the
    polyline.  If the text object is deleted, then the
    program will remove the reactor related to the polyline.
    Thanks to Luis Esquivel for his help and guidance.
    v1.0 2/2006 Tim Willey
    v1.1 5/2006 Added the ability to select an attribute.
|;

(if
(and
  (setq Sel (entsel "\n Select polyline to get area of: "))
  (setq EntData (entget (car Sel)))
  (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
  (setq PolyObj (vlax-ename->vla-object (car Sel)))
  (setq Sel (nentsel "\n Select text of hold area value: "))
  (setq EntData (entget (car Sel)))
  (or
   (if (vl-position (cdr (assoc 0 EntData)) '("TEXT" "MTEXT"))
    (setq TextSel T)
   )
   (= (cdr (assoc 0 EntData))  "ATTRIB")
  )
  (if TextSel
   (if (equal (length Sel) 2)
    T
    (prompt "\n Cannot select nested text.")
   )
   T
  )
  (setq TextObj (vlax-ename->vla-object (car Sel)))
)
(progn
  (PutArea PolyObj TextObj)
  (if
   (and
    (setq ReactList (AssociatedReactors PolyObj))
    (setq Pos (vl-position "MyAreaReactorModified" (mapcar 'vlr-data ReactList)))
   )
   (vlr-remove (nth Pos ReactList))
  )
  (vlr-pers
   (vlr-object-reactor
    (list PolyObj)
    "MyAreaReactorModified"
    '(
     (:vlr-modified . MakeCmdEndReactor)
     (:vlr-erased . ObjectEraseReactor)
;     (:vlr-unerased . ObjectUnErasedReactor)
    )
   )
  )
)
)
(princ)
)
;---------------------------------------------------------------------------------------------------------------
(defun PutArea (PolyObj TextObj / Dict xRec SqFt)

(setq Dict (vla-GetExtensionDictionary PolyObj))
(if (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor"))))
(setq xRec (vla-AddXRecord Dict "MyAreaReactor"))
)
(MySetXrec xRec '(40 1) (list (vlax-get PolyObj 'Area) (vlax-get TextObj 'Handle)))
(setq SqFt (/ (vla-get-Area PolyObj) 100000.0))
(vla-put-TextString TextObj (strcat (rtos SqFt 2 2) " m2."))
xRec
)
;----------------------------------------------------------------------------------------------------------------
(defun MakeCmdEndReactor (Obj React NotSure)

(if (not (wcmatch (getvar "cmdnames") "U,UNDO,REDO,OOPS"))
(progn
  (if GlbVarAreaObject
   (setq GlbVarAreaObject (append GlbVarAreaObject (list Obj)))
   (setq GlbVarAreaObject (list Obj))
  )
  (if (not GlbReactorCommandEnd)
   (setq GlbReactorCommandEnd (vlr-command-reactor "tempAreaCommandReactor" '((:vlr-commandEnded . AdjustTextObj))))
  )
)
)
(princ)
)
;------------------------------------------------------------------------------------------------------------------
(defun ObjectEraseReactor (Obj React NotSure)

(vlr-pers-release React)
(vlr-remove React)
)
;-----------------------------------------------------------------------------------------------------------------
(defun ObjectUnErasedReactor (Obj React NotSure)

(vlr-pers
(vlr-object-reactor
  (list Obj)
  "MyAreaReactorModified"
  '(
   (:vlr-modified . MakeCmdEndReactor)
   (:vlr-erased . ObjectEraseReactor)
   (:vlr-unerased . ObjectUnErasedReactor)
  )
)
)
)
;-----------------------------------------------------------------------------------------------------------------
(defun AdjustTextObj (React CommandList / Dict xRec xRecList TextObj)

(foreach Obj GlbVarAreaObject
(if (not (vlax-erased-p Obj))
  (progn
   (setq Dict (vla-GetExtensionDictionary Obj))
   (if (not (vl-catch-all-error-p (setq xRec (vl-catch-all-apply 'vla-Item (list Dict "MyAreaReactor")))))
    (progn
     (setq xRecList (MyGetXRec xRec))
     (if
      (and
       (setq tmpEnt (handent (cdr (assoc 1 xRecList))))
       (setq TextObj (vlax-ename->vla-object tmpEnt))
       (not (vlax-erased-p TextObj))
      )
      (PutArea Obj TextObj)
      (progn
       (foreach i (AssociatedReactors Obj)
        (if (= (vlr-data i) "MyAreaReactorModified")
         (progn
          (vlr-pers-release i)
          (vlr-remove i)
         )
        )
       )
       (prompt "\n Reactor has be removed because the text object has been erased.")
      )
     )
    )
   )
  )
)
)
(setq GlbVarAreaObject nil)
(vlr-remove GlbReactorCommandEnd)
(setq GlbReactorCommandEnd nil)
)
;---------------------------------------------------------------------------
(defun MySetXRec (Obj CodeList DataList / )
; Sets XRecordData. Dxf numbers between 1-369, except 5, 100, 105.
; See help for types and numbers to use.

(vla-SetXRecordData Obj
(vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbInteger
    (cons 0 (1- (length CodeList)))
   )
   CodeList
  )
)
(vlax-make-variant
  (vlax-safearray-fill
   (vlax-make-safearray
    vlax-vbVariant
    (cons 0 (1- (length Datalist)))
   )
   DataList
  )
)
)
)
;-----------------------------------------------------------------------------
(defun MyGetXRec (Obj / CodeType DataType)
; Retrive XRecordData for an object

(vla-GetXRecordData
Obj
'CodeType
'DataType
)
(if (and CodeType DataType)
(mapcar
  '(lambda (a b)
   (cons a (variant-value b))
  )
  (safearray-value CodeType)
  (safearray-value DataType)
)
)
)
;-------------------------------------------------------------------------------------
(defun AssociatedReactors (Obj / ReactList)
; Return a list of reactors (object type) associated with an object.
; Use like (AssociatedReactors (vlax-ename->vla-object (car (entsel))))

(foreach i (cdar (vlr-reactors :vlr-object-reactor))
(if (vl-position Obj (vlr-owners i))
  (setq ReactList (cons i ReactList))
)
)
ReactList
)
;---------------------------------------------------------------------------
(defun RemovePersReact ()
; Remove persistant reactors that don't have an owner.

(foreach i (vlr-pers-list)
(if (not (vlr-owners i))
  (progn
   (vlr-pers-release i)
   (vlr-remove i)
  )
)
)
)


Citaat van: dirkvijverberg op wo 31 05 2006, 20:29:16
Hallo

Is er in autocad een functie die kan uitreken hoeveel vierkanten meters iets is.  Ook als de tuin niet recht loopt en rare hoeken heeft.

Beste Dirk,

Vanaf AutoCAD 2005 kun je gebruikmaken van Fields(of velden), waarbij je o.a. eigenschappen
van getekende elementen los of in een tabel kan plaatsen.
In het boek van ir. R. BoeklagenISBN 90-72487-45-1 wordt dit in een voorbeeld uitgelegd.
In het voorbeeld wordt ook uitgegaan van de eigenschap van een polylijn, maar door
fields te gebruiken kan je het getal netjes naar m^2 omvormen en is waarde dynamisch.
Als de oppervlakte veranderd, veranderd ook de getalwaarde.
Zie ook http://www.cadsite.be/smf/index.php/topic,1208.0.html. voor een programma.

Met vriendelijke groet, HofCAD CSI

Beste Marcel,

ik heb net de door jouw geplaatste lisproutine bekeken. Dit werkt wel erg goed zeg. Handig dat de tekst telkens automatisch wordt bijgewerkt.

Groeten Reimer.

Citaat van: Marcel op vr 02 06 2006, 12:48:05
Hier nog eentje....

Beste CADliefhebbers,

Een geweldige code van Tim Wiley, alleen snap ik niet waarom hij het programma AreaReact
zo gemaakt heeft dat het alleen LWpolylijnen accepteert.
Met bijna hetzelfde gemak, is het programma ook geschikt voor alle objecten met
een oppervlakte(area) zoals o.a. ook gewone polylines en circles.
Dit is leuk omdat het commando PEDIT  bij de optie Fit en Spline van LWpolyline een polyline
maakt.

Ik snap daarom niet goed, waarom hij onderstaande code uit de top van het programma:

(if
      (and
       (setq Sel (entsel "\n Select polyline to get area of: "))
       (setq EntData (entget (car Sel)))
        (= (cdr (assoc 0 EntData)) "LWPOLYLINE")
        (setq PolyObj (vlax-ename->vla-object (car Sel)))
       (setq Sel (nentsel "\n Select text of hold area value: "))
       (setq EntData (entget (car Sel)))

niet  bijv. als volgt heeft geschreven

(if
       (and
       (setq Sel (entsel "\n Select entity to get area of: "))
        (setq PolyObj (vlax-ename->vla-object (car Sel)))
        (vlax-property-available-p PolyObj 'area)
       (setq Sel (nentsel "\n Select text of hold area value: "))
      (setq EntData (entget (car Sel)))

Groetjes HofCAD CSI

PS Ik ben blond.

Persoonlijk vind ik deze lisp het leukste:

Citaat van: Reimer op do 01 06 2006, 10:46:47

;Oppervlakte - plaatst tekst met oppervlakte van object
;Geschreven door Olivier Hautekeete
;
------------------
| Hoofdprogramma |
--------------------------------------------------------------
(defun c:Opp ()
(variables1)
(vl-load-com)
(setq oAcad (vlax-get-acad-object)
oDoc (vla-get-activedocument oAcad)
EntNm (vlax-Ename->vla-Object (car (entsel "\nSelekteer een polyline")))
EntAre (vla-get-area EntNm)
opp (strcat "Opp: " (rtos EntAre 2 2) " m2"))
(plaats_text)
(variables2)
)
--------------------------------------------------------------
| Variables1
--------------------------------------------------------------
(defun variables1 ()
(setq osmo (getvar "osmode"))
(setq cmd (getvar "cmdecho"))
(setq fil (getvar "filedia"))
(setq diz (getvar "dimzin"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setvar "filedia" 0)
(setvar "dimzin" 2)
)
--------------------------------------------------------------
| Variables2
--------------------------------------------------------------
(defun variables2 ()
(setvar "osmode" osmo)
(setvar "cmdecho" cmd)
(setvar "filedia" fil)
(setvar "dimzin" diz)
)
--------------------------------------------------------------
(defun plaats_text ()
(setq p (getpoint "\nGeef de plaats aan voor de oppervlakte... "))
(entmake (list '(0 . "TEXT") ;type entiteit
(cons 10 p) ;tekst invoegpunt
'(40 . 0.5) ;teksthoogte                             
(cons 1 opp) ;de tekst zelf
)
)
)
--------------------------------------------------------------
| Lisp-melding
--------------------------------------------------------------
(princ "\nCopyright (C) Hautekeete Olivier - augustus 2005.")(princ)
(princ "\nStart het commando met 'OPP'.")(princ)
--------------------------------------------------------------

maar kan ik ergens een regeltje toevoegen om een andere textstyle te kiezen???

Groetjes,
Markske

Probeer dit eens:


(defun plaats_text ()
  (setq OldStyle (getvar "TEXTSTYLE"))
  (setvar "TEXTSTYLE" "Standard")
  (setq p (getpoint "\nGeef de plaats aan voor de oppervlakte... "))
  (entmake (list '(0 . "TEXT");type entiteit
(cons 10 p) ;tekst invoegpunt
'(40 . 0.5) ;teksthoogte                             
(cons 1 opp) ;de tekst zelf
   ) ;_ end of list
  ) ;_ end of entmake
  (setvar "TEXTSTYLE" OldStyle)
) ;_ end of defun


Vervang "Standard" door de gewenste tekststijl.

Nop... de tekst komt nog steeds in Standard te staan 

Klopt je hebt gelijk.
Niet goed getest. 
Dit moet beter gaan.


(defun plaats_text ()
  (setq p (getpoint "\nGeef de plaats aan voor de oppervlakte... "))
  (entmake (list '(0 . "TEXT");type entiteit
'(7 . "Standard") ;textstyle
(cons 10 p) ;tekst invoegpunt
'(40 . 0.5) ;teksthoogte 
(cons 1 opp) ;de tekst zelf
   ) ;_ end of list
  ) ;_ end of entmake
) ;_ end of defun


En weer moet je "Standard" vervangen door de gewenste style.

Yes yes yes 

werkt perfect Joop!!!

Dank je wel 

groetjes,
Markske

Deze lisp geeft bij mij het aantal vierkante millimeters (ik neem aan dat ie de units aanhoud), maar is het ook mogelijk om hem het getal bijvoorbeeld te laten delen door 1000 zodat hij in mijn geval het aantal vierkante meters opgeeft ?