Vierkante meters

[Adrianus]

Beste allemaal,
Onlangs werd onderstaande LISP routine geplaatst waarmee mm2 automatisch kunnen worden omgezet naar m2. Mijn vraag is of iemand in staat is deze routine zodanig aan te passen dat deze ook meerdere oppervlakken automatisch bij elkaar optelt. Dan zou deze routine helemaal PERFECT zijn. Mijn kennis van LISP komt helaas te kort om dat zelf te kunnen. Met vriendelijke groet, Adrianus. 

Code Selecteer Uitklappen

(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 Selecteer entiteit: "))
        (setq PolyObj (vlax-ename->vla-object (car Sel)))
        (vlax-property-available-p PolyObj 'area)
       (setq Sel (nentsel "\n Selecteer de tekst: "))
      (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) 1000000.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)
  )
)
)
)


de lisp even in een code venster geplaats Bart

[EddyBeerke]

Hmmm... Je kunt ook met een field werken in plaats van reactors...
Zoals dit met twee teksten:

Code Selecteer Uitklappen

%<\AcObjProp Object(%<\_ObjId 8796081440112>%).TextString>%+%<\AcObjProp Object(%<\_ObjId 8796081440128>%).Backward \f "%bl2">%

In die twee teksten kun je ook een field zetten van de oppervlakte van een polyline.

[Adrianus]

Alvast bedankt voor deze reactie. Zal, als ik thuis ben, dit eens gaan uitproberen.

Groet,
Adrianus

[Adrianus]

Dit probleem heb ik op een alternatieve manier opgelost.
Na de benodigde solids in de oppervlakken aangegeven te hebben kan ik deze solids allemaal gelijktijdig selecteren en vervolgens via properties de cumulatieve oppervlakte opvragen. Deze oppervlakte moet ik wel zelf omrekenen maar dat is niet ze een probleem.