CADsite forum

Hallo iedereen,

Annotation en een field invoegen om oppervlakte van een hatch te weten is een sublieme manier om op een plan oppervlaktes van hatches te plaatsen. Persoonlijk vind ik het wat omslachtig om dit voor alle, soms heel veel, oppervlaktes te doen.

Onderstaande tool had ik gevonden en werkt heel goed. Is wel niet dynamisch, maar daar kan ik mee leven.
Gewoon klik op oppervlakte en inserten. Het kan niet eenvoudiger denk ik.

Naast de oppervlakte had ik echter graag de layernaam vermeld.

Wie kan mij helpen?

Groeten,
Bart

Re: Vierkanten meters
« Reactie #3 Gepost op: do 01 06 2006, 10:46:47 »
ReageerCitaat
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

Hallo Bart,

groeten van Reimer onder je post?

De routine die Joop en Tae ooit voor mij gemaakt hebben werkt bij mij niet meer. Ik heb het maken van oba aangepast door hier itoa aan toe te voegen. Vervolgens ook de warde van lin iets aangepast. Nu doet hij het weer.

Vervolgens heb ik de code iets uitgebreid zodat ook de laagnaam in de tekst wordt toegevoegd.
Ik ben benieuwd of dit iets voor je is.

Groeten,
Reimer


(defun c:ar6 (/ cm fd ar1 ar2 ar3 tab oba lu tpt lin lin2 wh)
  (vl-load-com)

  (setq cm (getvar "cmdecho"))
  (setvar"cmdecho" 0)
  (setq fd (getvar "fielddisplay"))
  (if (/= fd 0)
    (setvar"fielddisplay" 0)
  );_if

  (setq ar1 (entsel "\nSelect Area Boundary: "))
  (setq ar2 (car ar1))
  (setq tab (vlax-ename->vla-object ar2))
  (setq oba (itoa (vla-get-objectid tab))); zonder itoa krijg je hier een heel kort getal.

  (setq lu (getvar "lunits"))
  (setq tpt (getpoint"\nSelect Area Text Point: "))
  (cond
    ((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu6%qf1\">%")))
    ((= lu 4) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%")))
    ((= lu 5) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu5\">%")))
    ((= lu 3) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu2%ct4%qf1 SQ. FT.\">%")))
    ((= lu 1) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu1\">%")))
  )
  (setq lin2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Layer>%"))
  (command "mtext" tpt "w" "0" lin lin2 "")
  (princ)
)


Reimer,

Deze code werkt super.

Graag had ik nog wat fine-tuning kunnen doen.
Zal me na mijn dagelijkse bezigheden ne keer focussen in een tutural van lisp.

Maar hetvolgende nog over de ontvangen lisp.
- is er een mogelijkheid om de layernaam boven de oppervlakte-waarde te krijgen?
- kan de afronding van de oppervlakte-waarde slechts twee cijfers na de komma gebeuren?
- kan er achter de oppervlakte-waarde de eenheid geplaatst worden? Zijnde m²

Groeten en Reimer nogmaals bedankt.
Bart

Dat kan. Dit doe je door de volgende regel aan te passen:
oud:    (command "mtext" tpt "w" "0" lin lin2 "")
nieuw: (command "mtext" tpt "w" "0" lin2 lin "")

De nauwkeurigheid en eenheden kun je als volgt toevoegen:
oud:    ((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu6%qf1\">%")))
nieuw: ((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu2%pr2\">%" " m\\U+00B2")))

Wanneer je handmatig een field maakt in autocad dan zie je onder in het venster de field expression (zie bijlage). Deze wordt in de lisp nagemaakt. Ik heb bijvoorbeeld %pr2 toegevoegd om de gewenste precision te krijgen. Na de field expression heb ik nog de tekst " m\\U+00B2" toegevoegd zodat er m2 komt te staan.
Let er op dat in de lisp niet zomaar alle tekens gebruikt kunnen worden. Aanhalingstekens plaats je met \" en een backslash plaats je met \\.

Groeten,
Reimer



(defun c:ar6 (/ cm fd ar1 ar2 tab oba lu tpt lin lin2)
  (vl-load-com)

  (setq cm (getvar "cmdecho"))
  (setvar"cmdecho" 0)
  (setq fd (getvar "fielddisplay"))
  (if (/= fd 0)
    (setvar"fielddisplay" 0)
  );_if

  (setq ar1 (entsel "\nSelect Area Boundary: "))
  (setq ar2 (car ar1))
  (setq tab (vlax-ename->vla-object ar2))
  (setq oba (itoa (vla-get-objectid tab))); zonder itoa krijg je hier een heel kort getal.

  (setq lu (getvar "lunits"))
  (setq tpt (getpoint"\nSelect Area Text Point: "))
  (cond
    ((= lu 2) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu2%pr2\">%" " m\\U+00B2")))
    ((= lu 4) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%pr2%lu2%ct4%qf1 SQ. FT.\">%")))
    ((= lu 5) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu5%pr2\">%")))
    ((= lu 3) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%pr2%lu2%ct4%qf1 SQ. FT.\">%")))
    ((= lu 1) (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu1%pr2\">%")))
  )
  (setq lin2 (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Layer>%"))
  (command "mtext" tpt "w" "0" lin2 lin "")
  (princ)
)


Super Reimer,

Zo leer ik wat bij.

Echt super.

Bedankt

Reimer,

Kan die lisp ook aangepast worden om ipv opp, de lengte van een geselecteerde polyline weer te geven?

Groeten,
Bart

Verander de onderstaande regel:
oud:    (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Area \\f \"%lu2%pr2\">%" " m\\U+00B2")))
nieuw: (setq lin (strcat "%<\\AcObjProp Object(%<\\_ObjId " oba ">%).Length \\f \"%lu2%pr2\">%" "m")))
Ik heb deze niet getest, dus ik hoop dat ik geen typefouten heb gemaakt.

Groeten
Reimer

Dat lukt.

Bedankt