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. :shock: Dit werkt wel erg goed zeg. Handig dat de tekst telkens automatisch wordt bijgewerkt. :ole:

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. :oops:

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.  :oops:
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  :D

werkt perfect Joop!!!

Dank je wel  :wink:

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 ?

Citaat van: pieter op wo 12 07 2006, 14:44:00
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 ?

Ik heb hier wel iets voor je, alleen is dit geen lisp routine, maar een macro

_texteval 1;_area O;\text;\250;0;(strcat "opp:" (rtos (/ (getvar "AREA") 100000)) "m2");

Deze macro laat je een polyline selecteren en plaatst daarna een tekst.
Ik hoop dat je hier iets aan hebt.

Richard.

Hier heb ik denk ik wel iets aan maar ik heb totaal geen verstand van macro's  :?
Hoe krijg ik dit werkend ?

Met welke AutoCAD versie werk je?

2002  :wink:

Zal ik je dan mijn toolbar sturen waar hij al in zit?

Als dat ervoor zorgt dat het te gebruiken is graag :D
Is de inhoud van t bestand tekst die je hier kan posten of wil je mn mailadres ff hebben ? (weet niet of ik die hier mag posten  :?)

Tuurlijk mag je je e-mail adres posten, waarom niet?
Maar dit forum heeft een upload mogelijkheid. Er kunnen dus bijlages geplaatst worden bij een bericht.

Je mail adres staat in je profiel, gaat dus helemaal goed komen!

Vandaag of morgen krijg je van mij een mooi toolbartje. :wink:

P.s. en zoals de admin al zegt, je mag hier posten en uploaden.

okee  :D alvast bedankt

Hier komen de spullen!
Lees eerst de installatie instructie.

Succes!

Richard

Het werkt hoor dankjewel !!  :ole:

Daar doen we het voor! 8) :pintje:

Er moet alleen nog een nul bij :mrgreen:  ik krijg tien keer te veel m2 haha.  :pintje:

Dat hangt waarschijnlijk af, van de units die je hebt ingesteld in je options menu --> tabblad User Preferences.

Oplossing is simpel, pas de macro aan, naar eigen wens!

Richard

Citaat van: HofCAD op di 06 06 2006, 19:38:38
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:

Code Selecteer Uitklappen

(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

Code Selecteer Uitklappen

(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. :oops:

Dit werkt erg goed. Werkt fantastisch. Alleen zou ik het prettig vinden als het mogelijk is om niet eerst een tekst te moeten maken. Is het mogelijk deze applicatie zelf de tekst op b.v. middle center, op een eigen layer te zetten.

Met vriendelijke groet,
Alexander