field gegevens via lisp plaatsen

[Reimer]

Aangezien Joop zich aan het vervelen is heb  ik nog wel een vraag.

Voorheen zette ik vaak oppervlaktegegevens van plines bij de objecten m.b.v. een lisproutine.
Sinds de fields in acad gebruik ik liever een mtext met een field, welke van een geselecteerd object de area weergeeft. Als het object wijzigd dan wordt de oppervlaktetekst ook aangepast.
Het maken van zo'n mtext vind ik vrij bewerkelijk (erg veel muiswerk). Wanneer ik nu de eigenschappen van zo'n field bekijk dan zie ik de volgende gegevens:
%<\AcObjProp Object(%<\_ObjId 1983924088>%).Area \f "%lu2">%
Als ik deze text  simpelweg copieer en in een andere mtext plak dan krijg ik in deze nieuwe mtext de oppervlakte van mijn object. Wanneer ik nu de ObjId van een ander object opzoek en in de text plak dan krijg ik inderdaad de oppervlaktegegevens van het tweede object.

Mijn vraag: kan dit ook in een lisp.
Ik denk aan:
een object selecteren -> objId filteren -> mtext maken met de tekst %<\AcObjProp Object(%<\_ObjId (hier objId invullen) >%).Area \f "%lu2">%
Het is mij nog niet gelukt om de objId van een geselecteerd object te achterhalen.

Ik hoop dat iemand hier iets op weet.

Reimer

[Joop]

Het heeft even geduurd maar hier is dan de (visual) lisp om de ObjectId te voorschijn te toveren.
Ik heb geprobeerd om het automatisch in een field te zetten maar dit is niet gelukt.
De reden hiervoor is mij nog niet geheel duidelijk, maar zowel de mtext als de tekst vertalen de regel verkeerd.
B.v.: %<\AcObjProp Object(%<\_ObjId 2130055016>%).Area \f "%lu6%qf1">% wordt vertaald als AcObjProp Object(%<\_ObjId 0>%).Area f "%lu6%qf1" en soms als #### (hetgeen wel in een field staat).

Zoals je ziet vervalt er belangrijke informatie.

Code Selecteer Uitklappen

(defun c:AF (/)
  (setq SelectedObject (entsel))
  (setq SelectedObject (car SelectedObject))
  (setq SelectedObject (vlax-ename->vla-object SelectedObject))
  (setq SelectedObject (vla-get-ObjectId SelectedObject))
  (setq SelectedObject (itoa SelectedObject))
  (setq MeasuredArea
(strcat "%<\AcObjProp Object(%<\_ObjId "
SelectedObject
">%).Area \f \"%lu6%qf1\">%"
)
  )
)

Maar goed, ik blijf er op puzzelen en hoop dat jij de oplossing vindt.

[tae]

Is dit hetgeen jullie zoeken?

;;;arb
(defun plar(/ pt pt1 pt2)
(setq pt (getpoint"\nStarting Point: "))
(setq pt1 (getpoint pt "\nNext Point: "))
(command "Pline" pt pt1 "")
   (while
      (setq pt2 (getpoint pt1"\nNext Point: "))
      (command "pline" "" pt2 "")
      (command "pedit" pt "j" pt pt2 "" "")
      (setq pt1 pt2)
   )
(command "pedit" pt "c" "")
(princ)
)

(defun ar5 (/ cm fd ar1 ar2 ar3 tab oba lu tpt lin wh)
(vl-load-com)

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

    (setq ar1 (entsel "\nSelect Area Boundary: "))
    (setq ar2 (car ar1))
    (setq tab (vlax-ename->vla-object ar2))
    (setq oba (vla-get-objectid tab))

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

[tae]

Er is iets verkeerd gegaan met kopieren

;;;arb
(defun plar(/ pt pt1 pt2)
(setq pt (getpoint"\nStarting Point: "))
(setq pt1 (getpoint pt "\nNext Point: "))
(command "Pline" pt pt1 "")
   (while
      (setq pt2 (getpoint pt1"\nNext Point: "))
      (command "pline" "" pt2 "")
      (command "pedit" pt "j" pt pt2 "" "")
      (setq pt1 pt2)
   )
(command "pedit" pt "c" "")
(princ)
)

(defun ar5 (/ cm fd ar1 ar2 ar3 tab oba lu tpt lin wh)
(vl-load-com)

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

    (setq ar1 (entsel "\nSelect Area Boundary: "))
    (setq ar2 (car ar1))
    (setq tab (vlax-ename->vla-object ar2))
    (setq oba (vla-get-objectid tab))

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

(princ)
)      

(defun c:arb (/ key)
(initget  1 "Boundary/label-area Label-area")
(setq key (getkword "\nWould you like Boundary/label-area<B> or Label-area<L>: "))
   (cond
     ((= key "Boundary/label-area")(plar)(ar5))
     ((= key "Label-area")(ar5))
   )
(princ)
)

[Joop]

  Netjes!!! 

Nu nog een automatische field-update en je hebt een prachtige routine. 

[Reimer]

Heren mijn complimenten en hartelijke dank. Dit is wat ik zocht.
Hoe het werkt is voor mij nog niet duidelijk. Hiervoor is mijn lispkennis nog niet groot genoeg. Ik ga eens proberen dit uit te zoeken.

Bedankt!!

Reimer

[Markske]

Hele handige lisp!!!

Toevallig ben ik aan een project aan het werken waarbij ik vrij veel oppervlaktes moet berekenen...

Dank je wel tae 

Groetjes,
Markske