Author Topic: Area reactor  (Read 33923 times)

0 Members and 1 Guest are viewing this topic.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Area reactor
« Reply #15 on: May 31, 2006, 04:07:54 PM »
Tim

Need to include your PutArea function.

Gary
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Area reactor
« Reply #16 on: May 31, 2006, 05:05:12 PM »
I figured the OP got the routine from the main one the OP linked to in his post.  Just in case that is not the case, here is the lisp file again (with the updated portion).
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

MvdP

  • Guest
Re: Area reactor
« Reply #17 on: June 01, 2006, 04:31:22 AM »
Thanks Tim it is working perfectly.
I decided to take a shot and try to implement my wishes into your code(hope you don't mind) ,for learning purposes  too.
The first thing i added was  a dialog box into your code and that is working so far.
After that i tried to add in the dcl  a view radio buttons for the selection of the suffix (m2 ,mm2 sq ft),that is working also but  i encountered a problem in the lisp it is not working the way it should and i can't seem to figure this one out.What am i doing wrong help would be appreciated.


DCL

Code: [Select]
ddareareact : dialog {
value = "DDareaReact";
key = "title";

:row {
: boxed_column {
label="Text Settings: ";

: edit_box {
label = "Area Name:   ";
key = "areaname";
fixed_width = true;
}

}

:spacer{
width=0;
}





: column {
: boxed_row { label = "< Labeling Units >";
: radio_column {key = "lu";
: radio_button {label = "Area in Millimeters" ; key = "mm"; value = "1";}
: radio_button {label = "Area in Meters" ; key = "mtr"; }
: radio_button {label = "Area in Square Feet" ; key = "sqf"; }
}
}}



: column {
: boxed_column { label = "< Labeling Suffix >";
: radio_column {key = "ls";
: radio_button {label = "MM2" ; key = "MM2"; value = "1";}
: radio_button {label = "M2" ; key = "M2"; }
: radio_button {label = "Sq. Ft." ; key = "sqft"; }
}
}}


}


:spacer{
height=0;
}




:spacer{
height=1;
}



:row{

:spacer{
width=3;
}

:button{
label="Select Objects";
key="accept";
}


cancel_button;



:spacer{
width=3;
}

}


}




Code: [Select]
;|  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.
|;



(defun c:DDAreaReact (/ Sel EntData PolyObj TextObj ReactList Pos TextSel)
   (setq DH (load_dialog "ddareareact"))
   (new_dialog "ddareareact" DH)
   (action_tile "accept" "(done_dialog 1)")
  (setq ls (get_tile \"ls\"))
  (action_tile "cancel" "(exit)(exit)")
   (setq RET (start_dialog))



(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) 144.0))
(vla-put-TextString TextObj (strcat (rtos SqFt 2 2) ls ))
;;'(vla-put-TextString TextObj (strcat (rtos SqFt 2 2) " SQ.FT."))
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)
  )
 )
)
)

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Area reactor
« Reply #18 on: June 01, 2006, 11:18:22 AM »
I didn't test it, but is it doing that you think it shouldn't be doing?  If you want to select the suffix, then after the first time, you will have to search the string to see what the suffix is, and add that you the string you are putting.

Maybe a before, and after of what you want.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

MvdP

  • Guest
Re: Area reactor
« Reply #19 on: June 01, 2006, 11:28:57 AM »
No it  isn't n doing what is supposed to do.I can select a suffix but then returns an error.!!

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Area reactor
« Reply #20 on: June 01, 2006, 11:56:25 AM »
What does the error say?
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

MvdP

  • Guest
Re: Area reactor
« Reply #21 on: June 01, 2006, 12:05:05 PM »
I am not behind a computer with autocad installed.So i can give you the error tomorrow.
But i am sure it has something to do with these two parts of the code.

Code: [Select]
(setq ls (get_tile \"ls\"))


Code: [Select]
(vla-put-TextString TextObj (strcat (rtos SqFt 2 2) ls ))

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Area reactor
« Reply #22 on: June 01, 2006, 12:21:37 PM »
I will see if I can test it today then, and let you know what I think.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Area reactor
« Reply #23 on: June 01, 2006, 03:56:38 PM »
You are going to have to put in some thought as to how you want to handle this.  If it was me, I would store the information per drawing in a dictionary.  I would tell it how I wanted my calculation to be.  I would check to see what the drawing units are, and if they are not assigned, then I would make them be assigned, so that you know how to calculate the area.

So if you have a drawing in inches, and you want the area expressed as square foot, then you would put square foot into the dictionary.  This way your routine will no what number to divide/multiple by to get the correct area you want.

This will take some work (not to hard though), and as I don't see any use for me, I don't think I will have the time to code it all up for you, but I will be able to help you if you need help with some of the steps.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

MvdP

  • Guest
Re: Area reactor
« Reply #24 on: June 02, 2006, 02:19:07 AM »
I gave it some thoughts and this is what i finally want.

I want this routine to insert a block on a given point with 2 attributes one for the room name (entered in dcl via edit box) and one for the area in m2,after selecting the closed polyline.And forget the suffix choosing part,but first off all offcourse  can this be done.?

Keith™

  • Villiage Idiot
  • Seagull
  • Posts: 16899
  • Superior Stupidity at its best
Re: Area reactor
« Reply #25 on: June 02, 2006, 07:31:04 AM »
I have done something very similar in VBA
Proud provider of opinion and arrogance since November 22, 2003 at 09:35:31 am
CadJockey Militia Field Marshal

Find me on https://parler.com @kblackie

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Area reactor
« Reply #26 on: June 02, 2006, 11:39:45 AM »
I gave it some thoughts and this is what i finally want.

I want this routine to insert a block on a given point with 2 attributes one for the room name (entered in dcl via edit box) and one for the area in m2,after selecting the closed polyline.And forget the suffix choosing part,but first off all offcourse  can this be done.?


What you want isn't to hard to code.  Prompt for the room number, then insert the block.  Step through the block, and change the one attribute to what the user provided, and then get the object name for the other attribute, and pass that to the code.  You won't need to prompt to select text object then.  You would only prompt to select the pline, and then for the insertion point of the block, and the room name/number.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

MvdP

  • Guest
Re: Area reactor
« Reply #27 on: June 06, 2006, 11:56:14 AM »
Quote
What you want isn't to hard to code.

For me it is VERY hard to code this as a newbie in lisp, but maybe with help from this amazing forum i can accomplish this.

MvdP

  • Guest
Re: Area reactor
« Reply #28 on: June 08, 2006, 09:40:10 AM »
It is indeed very hard but also a lot of fun doing this.
.
I am working with fields (as suggested before) to do this and got it working whitout a dcl.
The routine inserts a block ,after selecting a polyline, with 2 att. and prompts on the command line for area name and insert the block on a given point with area name and area in m2.
But  i think it is fancier with a DCL ( to choose  from a drop-downlist for the room name instead on the command line ) ,but i got an error.

; error: misplaced dot on input

But i cant figure out why.This is what i got so far.Don't know if this routine is going somewhere but it is for learning purposes also.

DCL
Code: [Select]
DDlabelarea : dialog {
value = "DDLabelArea 2006";
key = "title";


        : popup_list { key = "areanamelist"; width = 30;}

:spacer{
width=0;

}

:spacer{
height=1;
}

:row{

:button{
label="Select Objects";
width = 14;
key="accept";
}

:spacer{
height=5;
}

cancel_button;
}
}

LSP
Code: [Select]
(defun c:ddla (/ cm fd ar1 ar2 ar3 tab oba lu tpt lin wh)
(vl-load-com)

(setq areanamelist(list "RoomA" "roomB" "RoomC" "RoomD"))
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)

(setq DH (load_dialog "DDlabelarea"))
(new_dialog "DDlabelarea" DH)
(progn
(setq area-name (get_tile \"areanamelist\"))
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(exit)(exit)")
(setq RET (start_dialog))}

  (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 area-name (getstring T "\nAssign Area Name:  "))

(princ)
(setq inspoint (getpoint "\nPick label insertion point:  "))
(princ)
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, m2]%ds44%ct8[1e-006]\">%"))
(setvar "attdia" 0)
(setvar "attreq" 1)
(setq schaal (rtos(getvar "userr1")))
(command "-insert" "oppervlakte" "s" schaal inspoint "" area-name objarea )
(setvar "attdia" 1)
(setvar "attreq" 1)
(princ)
)

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Area reactor
« Reply #29 on: June 08, 2006, 11:16:15 AM »
Try this lisp routine.  See what is the difference between the two (mine and yours).  I didn't comment, as I just did it quick.

Code: [Select]
(defun c:ddla (/ cm fd ar1 ar2 ar3 tab oba lu tpt lin wh)
(vl-load-com)

(setq areanamelist(list "RoomA" "roomB" "RoomC" "RoomD"))


(setq DH (load_dialog "DDlabelarea"))
(new_dialog "DDlabelarea" DH)
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)
;(progn
;(setq area-name (get_tile \"areanamelist\"))
(action_tile "accept" "(done_dialog 1) (setq area-name (get_tile \"areadnamelist\"))")
(action_tile "cancel" "(exit)(exit)")
(setq RET (start_dialog))}

  (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 area-name (getstring T "\nAssign Area Name:  "))

(princ)
(setq inspoint (getpoint "\nPick label insertion point:  "))
(princ)
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, m2]%ds44%ct8[1e-006]\">%"))
(setvar "attdia" 0)
(setvar "attreq" 1)
(setq schaal (rtos(getvar "userr1")))
(command "-insert" "oppervlakte" "s" 1.0 inspoint "" area-name objarea )
(setvar "attdia" 1)
(setvar "attreq" 1)
(princ)
)
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.