TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: MvdP on May 23, 2006, 11:46:43 AM
-
I am searching for a area reactor that will let you pick a boundary (closed polyline)
and inserts a block with attributes for sq.meters and the purpose of this selected area.Is there one around here on this forum which is working this way.?
-
Try fields. Then you can use standard Autocad.
If you don't have 2005+ you can do a search on this forum.
-
I did search and i found several reactors, but to me it seems that they are not completely working.Or am i missing one.
-
http://www.theswamp.org/index.php?topic=9573.0
http://www.theswamp.org/index.php?topic=7308.0
http://www.theswamp.org/index.php?topic=6559.0
http://www.theswamp.org/index.php?topic=8710.0
But fields are so easy to use:
- Place the block with the attribute
- _.eattedit > rightclick on value > Insert Field...
- Field category = Objects
- Field names: = Object
- Object type > Pick (select your polyline)
- Property = Area , Format (make a selection from the list)
- You can also change the Field Format if you like (or add a prefix/suffix)
- In the enhanced Attribute Editor select OK
If you stretch the polyline the attribute will change. It doesn't show inmedially though: It depents on the value of FIELDEVAL how often fields update, but you can always use the command UPDATEFIELD
FIELDEVAL:
0 Not updated
1 Updated on open
2 Updated on save
4 Updated on plot
8 Updated on use of ETRANSMIT
16 Updated on regeneration
31 All options
-
I don't think you can write sq. meters in fields...
-
I don't think you can write sq. meters in fields...
If your drawing is in mm then you can convert mm2 to m2 in the `Field format`-dialog:
-
I don't have much time right now, but it's easy to make something in lisp without a reactor.
First you need to compose the field format. That can be done with the FIELD-command (see picture)
A lisp file looks something like this (not tested):
;================================================
; AreaDemo using fields 24-05-2006 by J.J.Damstra
; http://www.theswamp.org/index.php?topic=10248.0
;================================================
(defun c:AreaDemo (/ ce entity oba fieldstring)
(vl-load-com)
(setq ce (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq entity (car (entsel "\nSelect a closed polyline: ")))
(setq oba (vla-get-objectid (vlax-ename->vla-object entity)))
;Use the FIELD-command to compose the next line:
;%<\AcObjProp.16.2 Object(%<\_ObjId 2130265440>%).Area \f "%lu2%ps[,m2]%ds44%ct8[1e-006]">%
(setq fieldstring (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(rtos oba 2 0)
">%).Area \f "%lu2%ps[,m2]%ds44%ct8[1e-006]">%"))
; (RE)PLACE THE STRING IN YOUR DRAWING HERE
(setvar "CMDECHO" ce)
(princ)
)
-
Maybe this can be turned into a challenge and make an area reactor that looks like this one.!!!!!
http://www.atablex.com/toolkit-help/labelroom.htm
-
If your drawing is in mm then you can convert mm2 to m2 in the `Field format`-dialog:
Ahhh, didn't recognize that... but this option is only available with A2k6+, not with A2k5.
-
I checked all of the above and found out that this one
http://www.theswamp.org/index.php?topic=8710.0
is the best working rector (written by T.willey) but ,i my wish for this reactor is the following.
- That it will insert a block (with att.) on a picked place and let the routine insert the values in this block.(This routine was also available but not working correctly and gave me errors.)
- And in the same block an areaname att. (f.i. kitchen, bathroom) input via dcl and this may too come in handy a range of radio buttons for choosing feet or mm and maybe precision.
-
***bites tongue
hard***
-
$10 , One License Code
-
I checked all of the above and found out that this one
http://www.theswamp.org/index.php?topic=8710.0
is the best working rector (written by T.willey) but ,i my wish for this reactor is the following.
- That it will insert a block (with att.) on a picked place and let the routine insert the values in this block.(This routine was also available but not working correctly and gave me errors.)
- And in the same block an areaname att. (f.i. kitchen, bathroom) input via dcl and this may too come in handy a range of radio buttons for choosing feet or mm and maybe precision.
If I have some time, then I will look into making it work with text or attributes. I don't know how hard that will be, since I had a lot of help from Luis to write that one.
-
If I have some time, then I will look into making it work with text or attributes. I don't know how hard that will be, since I had a lot of help from Luis to write that one.
Thanks Tim that would be highly appreciated.
-
It won't be in any form difficult at all, I do not write or use routines with reactors anymore, I would prefer nowdays that if it is one available and cheap, to buy it. :-)
To true Luis. I'm just using it as a learning thing. I don't have a use form them in my day to day cad life, but it is fun to learn.
Here is the updated main routine.
(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)
)
-
Tim
Need to include your PutArea function.
Gary
-
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).
-
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
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;
}
}
}
;| 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)
)
)
)
)
-
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.
-
No it isn't n doing what is supposed to do.I can select a suffix but then returns an error.!!
-
What does the error say?
-
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.
(setq ls (get_tile \"ls\"))
(vla-put-TextString TextObj (strcat (rtos SqFt 2 2) ls ))
-
I will see if I can test it today then, and let you know what I think.
-
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.
-
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.?
-
I have done something very similar in VBA
-
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.
-
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.
-
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
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
(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)
)
-
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.
(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)
)
-
I have tested your code and the difference is that yours is showing the drop downlist.
But it gives an error.I think it seems to be that the variable area-name is not set from the drop downlist.
I checked it by letting it print the two variables on the commandline,but no show.!!!!
(defun c:ddla (/ ar1 ar2 tab oba inspoint objarea)
(vl-load-com)
(setq areanamelist(list "RoomA" "RoomB" "RoomC" "RoomD" "RoomE"))
(setq DH (load_dialog "DDlabelarea"))
(new_dialog "DDlabelarea" DH)
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)
(action_tile "accept" "(done_dialog 1) (setq area-name (get_tile \"areanamelist\"))")
(action_tile "cancel" "(exit)(exit)")
(setq RET (start_dialog))}
(setvar "cmdecho" 1)
(setq fd (getvar "fielddisplay"))
(if (/= fd 1)(setvar"fielddisplay" 1))
(setq ar1 (entsel "\nSelect Area Boundary: "))
(setq ar2 (car ar1))
(setq tab (vlax-ename->vla-object ar2))
(setq oba (vla-get-objectid tab))
(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")))
(princ objarea)
(princ area-name)
;;(command "-insert" "oppervlakte" "s" schaal inspoint "" area-name objarea )
(setvar "attdia" 1)
(setvar "attreq" 1)
(princ)
)
-
Okay, sorry about that. Here is the one that works.
(defun c:ddla (/ ar1 ar2 tab oba inspoint objarea)
(vl-load-com)
(setq areanamelist(list "RoomA" "RoomB" "RoomC" "RoomD" "RoomE"))
(setq DH (load_dialog "DDlabelarea"))
(new_dialog "DDlabelarea" DH)
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)
(action_tile "accept" "(setq area-name (get_tile \"areanamelist\"))(done_dialog 1)")
(action_tile "cancel" "(exit)(exit)")
(setq RET (start_dialog))}
(setvar "cmdecho" 1)
(setq fd (getvar "fielddisplay"))
(if (/= fd 1)(setvar"fielddisplay" 1))
(setq ar1 (entsel "\nSelect Area Boundary: "))
(setq ar2 (car ar1))
(setq tab (vlax-ename->vla-object ar2))
(setq oba (vla-get-objectid tab))
(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")))
(princ objarea)
(print area-name)
(command "-insert" "oppervlakte" "s" 1.0 inspoint "" (nth (atoi area-name) areanamelist) objarea )
(setvar "attdia" 1)
(setvar "attreq" 1)
(princ)
)
I don't know where the variable "schaal" is being set, so I took it out to test here.
-
Thanks again Tim.Where would i be without you.(and offcourse this the Swamp)
I am not able to test your code right now but i have another question.
When working with fields and adjust the area (polyline) you have to regen to display the new values.Is it somehow possible to show this immediately so without a regen.?
The variable "schaal" is the scale factor.
The routine inserts the block called "oppervlakte" times the scale.(but this works)
-
You're welcome.
As far as fields go, I have no idea. I don't use them, sorry I can't be more help.
-
Thanks Tim it worked perfectly.I added a drop down list for rotation and this is working also.
So now i want to go further.How can this be done(if possible).?
After the routine has been inserted the block and adjusted the values how to select in lisp the block and the corresponding polyline so that the two objects can be hatched in a specific pattern(depends of area-name ,i want to add a toogle yes/no option in dcl).
F.i. Room A -D has a user singel hatch pattern with an angle of 45 and the toilet has the same but double hatch pattern.
-
You will already know the polyline objects name (got it from entsel), and to grab the blocks, just use "entlast" after you insert it. Then look at the hatch command, and see how you would hatch it, with selecting an object.
-
So if i understand it correctly i have to do something like this.
I have to set a variable f.i. hatchobjects
(setq hatchobjects(entlast)) ;;;;;; for selecting the block
after this do this
(command "-bhatch" hatchobjects - here the hatch settings i want.- )
but where do i put ar1 (polylines name) to combine it with entaslt.
Btw i hope you don't mind me asking so much questions.As stated before i am no stranger with AutoCAD (started with v 2.6 a thought it was) but a total newbie with programming.And it is a lot of fun.
-
(command "_.bhatch" "_s" ar1 hatchobject "")
This will select the two objects. Now you will need to set the pattern, and scale. It's okay to ask questions, as long as you try the answers posted. We are here to teach/learn, so ask away.
-
Off course i am trying all the answers posted ,and i am learning all the time.
So now i got this thing working but not yet the way i want.So let me try to explain how i want it to work.And ask two questions.
Question 1
If i select the area name f.i. "room A'" i want it hatched user defined single and when i select the area name f.i. toilet i want it to be hatched the same but double.How to do this.
Tried this but no luck.
(if (= hatch-area "J" = area-name "Room A")(command "-bhatch" "s" ar1 hatchobjects "" "p" "u" "45" "150" "n" ""))
(if (= hatch-area "J" = area-name "Toilet" ) (command "-bhatch" "s" ar1 hatchobjects "" "p" "u" "45" "150" "y" ""))
Question 2
I want the selection option to select only a closed polyline, and when i do not select a prompt.
This is what i got so far but again i cant figure out what is wrong with this.
(defun do_pick (/ area1)
(while (setq area1 (entsel "\nSelect polyline: "))
(if
(member (cdr (assoc 0 (setq entlst (entget (car area1)))))
'("LWPOLYLINE" ))
)
(prompt "\nError selected object is NOT a LWpolyline.")
)
)
(if (null area1)
(prompt "\nNothing selected.............................")
)
)
and change this
(setq area1 (entsel "\nSelect Area Boundary: "))
(setq area2 (car area1))
(setq tab (vlax-ename->vla-object area2))
(setq oba (vla-get-objectid tab))
into this
(do_pick)
(setq area2 (car area1))
(setq tab (vlax-ename->vla-object area2))
(setq oba (vla-get-objectid tab))
-
Answer 1.
You should use a (cond.... not an (if.... If you have more that two options, then use (cond... it's a general rule I use. So it would look like
(cond
((= area-name "RoomA")
(setq DblHatch "_n")
)
((= area-name "Toilet")
(setq DblHatch "_y")
)
)
(command "_.bhatch" "_s" ar1 hatchobjects "" "_p" "_u" "45" "150" DblHatch "")
Answer 2
If you only want to select closed polylines, then you need to check the dxf code 70. So something like
(while (not (setq ss (ssget ":e:s" '((0 . "LWPOLYLINE") (70 . 1))))))
-
A reaction to answer 1.So this is also possible.?
(cond
((= area-name "RoomA")
(setq DblHatch "_n")(setq AngHatch "45")
)
((= area-name "Toilet")
(setq DblHatch "_y")(setq AngHatch "135")
)
)
(command "_.bhatch" "_s" ar1 hatchobjects "" "_p" "_u" AngHatch "150" DblHatch "")
-
Yup. That is another good thing about (cond... 's. With and (if... statement, you can only have one action happen per statement, that is why you need the (progn.... when you want more than one thing to happen, but with (cond... you don't need the (progn....
-
Thanks for the info about the conds ,but I still dont get it where to put this.
(while (not (setq ss (ssget ":e:s" '((0 . "LWPOLYLINE") (70 . 1))))))
and where to put the text when nothing is selected, and the text when anything else but a polyline is selected.
-
This will only let you select a closed pline. You will have to escape out of it. Have you tried it? After you get past the loop, then you will set ar1 to the only object (or the first object) in the selection set.
(setq ar1 (ssname ss 0))
This will get you the closed polyline that was selected.
-
I will try tomorrow.Now i am going to watch tv (WC 2006 in Germany) and have diner.
-
I tried it all and it is not going the way i want and should.
- The cond section is not working, the variables "anghatch" and "dblhatch" are not set.
- The polyline only selection is not working it returns an error
bad argument type: consp <Entity name: 7e258c68>
Once again i can't figure it out what i am doing wrong.
; DDlabelArea.lsp
(defun c:ddla (/ area1 area2 tab oba inspoint objarea)
(setq areanamelist(list
""
"Verblijfsgebied A"
"Verblijfsgebied B"
"Verblijfsgebied C"
"Verblijfsgebied D"
"Verblijfsgebied E"
"Verblijfsgebied F"
"Verblijfsgebied G"
"Verkeersgebied"
"Onbenoemde Ruimte"
"Badkamer"
"Toilet"
))
(setq rotationlist(list
"0"
"45"
"90"
"135"
"180"
"225"
))
; ************************************************
(defun txtbox_infohulp ()
(alert
(strcat
"DDLabelArea 2006 Help.\n\n"
"Please report any problems you may have.\n\n"
)
)
)
; ************************************************
(setq DDLA (load_dialog "DDlabelarea"))
(new_dialog "DDlabelarea" DDLA)
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)
(start_list "rotationlist")
(mapcar 'add_list rotationlist)
(end_list)
; ************************************************
(defun do_hatch ()
(if (= (get_tile "do-hatch") "1")(setq hatch-area "J"))
(if (/= (get_tile "do-hatch") "1")(setq hatch-area "N"))
)
; ************************************************
(action_tile "accept" "(setq area-name (get_tile \"areanamelist\"))(setq rotation (get_tile \"rotationlist\"))(done_dialog 1)")
(action_tile "do-hatch" "(do_hatch)")
(action_tile "hulp" "(txtbox_infohulp)")
(action_tile "cancel" "(exit)(exit)")
(setq RET (start_dialog))}
(setvar "cmdecho" 1)
(setq fd (getvar "fielddisplay"))
(if (/= fd 1)(setvar"fielddisplay" 1))
;;(setq area1 (entsel "\nSelect Area Boundary: "))
(while (not (setq ss (ssget ":e:s" '((0 . "LWPOLYLINE") (70 . 1))))))
(setq area1 (ssname ss 0))
(setq area2 (car area1))
(setq tab (vlax-ename->vla-object area2))
(setq oba (vla-get-objectid tab))
(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 (nth (atoi rotation) rotationlist) (nth (atoi area-name) areanamelist) objarea )
(setq hatchobjects(entlast))
(command "-layer" "s" "00---0-a_Arceer" "")
(cond
((= area-name "Verblijfsgebied A")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied B")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Toilet") (setq anghatch "135")(setq dblhatch "n"))
((= area-name "Verkeersgebied") (setq anghatch "45") (setq dblhatch "y"))
)
(if (= hatch-area "J")(command "-bhatch" "s" area1 hatchobjects "" "p" "u" anghatch "150" dblhatch ""))
(setq hatch-area nil )
(setq hatchobjects nil )
(setq anghatch nil )
(setq dblhatch nil)
(command "-layer" "s" "0" "")
(setvar "attdia" 1)
(setvar "attreq" 1)
(princ)
)
DDlabelarea : dialog {
value = "DDLabelArea 2006";
key = "title";
:boxed_row { label = "< Select Area Name >";
:popup_list { key = "areanamelist"; width = 30;}}
:spacer{height=1;}
:row{
:boxed_row { label = "< Rotation >";
:popup_list {key = "rotationlist"; fixed_width = true; width = 5; }}
:boxed_row { label = "< Hatch > ";
:spacer{height=2;}
:toggle { label = "Yes"; key = "do-hatch";mnemonic = "Y";}}}
:row{
:button{label="Sel. Object ";width =10;height = 1.4;key="accept";mnemonic = "S";}
:button{label="Help" ;width =10;height = 1.4;key="hulp" ;mnemonic = "H";}
:spacer{height=5;}
cancel_button;
}
}
-
.. and which line did the error occur on .. ?
-
When I run the lisp 'area1' returns:
_$ area1
<Entity name: 7ef71ea8>
_$
So --> (setq area2 (car area1))
has to be --> (setq area2 area1)
-
Kerry Brown the error occurred after selecting the polyline and thanks gerstal82 that worked.(don't know the difference)
But how to do this.
Prompt on the command line to select closed polyline "\nSelect Area Boundary: "
Prompt on the command line when selected object is not a closed polyline "\nError selected object is NOT a Closed LWpolyline.
Prompt on the command line when nothing is selected. "\nNothing selected..........."
-
You can try this to see if a polyline is closed or not
http://discussion.autodesk.com/thread.jspa?messageID=1187865
-
The code T.Willey posted already sees if a polyline is closed or not,but i like a prompt on the command line
when a certain selected object is not a closed polyline "\nError selected object is NOT a Closed LWpolyline.
-
(prompt "\nSelect Area Boundary: ")
(while (not (setq ss (ssget ":e:s" '((0 . "LWPOLYLINE") (70 . 1)))))
(prompt "\n Object selected is NOT an LWPolyline. ")
)
-
Thanks Tim.
Any thoughts on the problem i am having in the conditions section , the variables "anghatch" and "dblhatch" are not being set..
When i do (princ area-name) on commandline it returns a number f.i. toilet returns 3..
(cond
((= area-name "Verblijfsgebied A")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied B")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Toilet") (setq anghatch "135")(setq dblhatch "n"))
((= area-name "Verkeersgebied") (setq anghatch "45") (setq dblhatch "y"))
)
not even when i do this
(command "-bhatch" "s" area1 hatchobjects "" "p" "u" anghatch "150" dblhatch "")
instead of this.
(if (= hatch-area "J")(command "-bhatch" "s" area1 hatchobjects "" "p" "u" anghatch "150" dblhatch ""))
Another thing i thought would be working but is not is this.make default do-hatch on with value ="1"(see code below) and uncheck (toggle) if you dont want the object to be hatched, but it do not hatch anything.
:toggle { label = "Yes"; key = "do-hatch";mnemonic = "Y";value = "1";}
-
I will look more into this when I get a chance, right now REAL (drafting, phttts...) work calls.
-
I thought i got it but,this
((= (nth (atoi area-name) areanamelist) "1")(setq anghatch "135")(setq dblhatch "n"))
or this
((= (nth (atoi area-name) areanamelist) "Badkamer")(setq anghatch "135")(setq dblhatch "n"))
isn't working either.!!!
-
I have another question is there something like an and in conditions in lisp .f.i.
((= a "b") and (= c "d") (setq w "x") (setq y "z"))
-
This one is quick. Yes.
(cond
(
(and
(equal 1 1)
(equal 2 2)
)
(princ "\n True")
)
)
-
Got no access to AutoCAD right now,so if understand it correctly it would look like this.?
(cond
(and(= suffix "suffix1")(= prec "0.0")
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps[, m2]%ds44%ct8[1e-006]\">%")))
(and(= suffix "suffix1")(= prec "0.00")
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, m2]%ds44%ct8[1e-006]\">%")))
(and(= suffix "suffix1")(= prec "0.000")
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps[, m2]%ds44%ct8[1e-006]\">%")))
(and(= suffix "suffix1")(= prec "0.000")
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps[, m2]%ds44%ct8[1e-006]\">%")))
(and(= suffix "suffix1")(= prec "0.0000")
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
)
And so on...
-
Nope. You have your and statement set up wrong. You have to have it set up like this
(cond
( ; This is the first test
(and ; You are saying you want to test more than one condition, and you want them to both be true
(equal 1 1)
(equal 2 2)
) ; End your and statement
(prompt "\n True")
) ; End the first operation of the cond
So yours would look like
(cond
( ; <- added
(and
(= suffix "suffix1")(= prec "0.0")
) ;<- added
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps[, m2]%ds44%ct8[1e-006]\">%"))
) ; <- added
... the rest of your code....
-
OK Thanks i got it..
-
Try this when you get a chance.
; DDlabelArea.lsp
(defun c:ddla (/ area1 area2 tab oba inspoint objarea)
(setq areanamelist(list
""
"Verblijfsgebied A"
"Verblijfsgebied B"
"Verblijfsgebied C"
"Verblijfsgebied D"
"Verblijfsgebied E"
"Verblijfsgebied F"
"Verblijfsgebied G"
"Verkeersgebied"
"Onbenoemde Ruimte"
"Badkamer"
"Toilet"
))
(setq rotationlist(list
"0"
"45"
"90"
"135"
"180"
"225"
))
; ************************************************
(defun txtbox_infohulp ()
(alert
(strcat
"DDLabelArea 2006 Help.\n\n"
"Please report any problems you may have.\n\n"
)
)
)
; ************************************************
(setq DDLA (load_dialog "DDlabelarea"))
(new_dialog "DDlabelarea" DDLA)
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)
(start_list "rotationlist")
(mapcar 'add_list rotationlist)
(end_list)
; ************************************************
(defun do_hatch ()
(if (= (get_tile "do-hatch") "1")(setq hatch-area "J"))
(if (/= (get_tile "do-hatch") "1")(setq hatch-area "N"))
)
; ************************************************
(action_tile "accept" "(setq area-name (get_tile \"areanamelist\"))(setq rotation (get_tile \"rotationlist\"))(done_dialog 1)")
(action_tile "do-hatch" "(do_hatch)")
(action_tile "hulp" "(txtbox_infohulp)")
(action_tile "cancel" "(exit)(exit)")
(setq RET (start_dialog))
(setvar "cmdecho" 1)
(setq fd (getvar "fielddisplay"))
(if (/= fd 1)(setvar"fielddisplay" 1))
;;(setq area1 (entsel "\nSelect Area Boundary: "))
(while (not (setq ss (ssget ":e:s" '((0 . "LWPOLYLINE") (70 . 1))))))
(setq area1 (ssname ss 0))
(setq area2 area1)
(setq tab (vlax-ename->vla-object area2))
(setq oba (vla-get-objectid tab))
(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 (nth (atoi rotation) rotationlist) (nth (atoi area-name) areanamelist) objarea )
;(command "-insert" "det-bub" "s" schaal inspoint (nth (atoi rotation) rotationlist) (nth (atoi area-name) areanamelist) objarea )
(setq hatchobjects(entlast))
(command "-layer" "n" "00---0-a_Arceer" "")
(setq area-name (nth (atoi area-name) areanamelist))
(cond
((= area-name "Verblijfsgebied A")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied B")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Toilet") (setq anghatch "135")(setq dblhatch "n"))
((= area-name "Verkeersgebied") (setq anghatch "45") (setq dblhatch "y"))
)
(print anghatch)
(print dblhatch)
(if (= hatch-area "J")(command "-bhatch" "s" area1 hatchobjects "" "p" "u" anghatch "150" dblhatch ""))
(setq hatch-area nil )
(setq hatchobjects nil )
(setq anghatch nil )
(setq dblhatch nil)
(command "-layer" "s" "0" "")
(setvar "attdia" 1)
(setvar "attreq" 1)
(princ)
)
One thing I would do is get all the information from the dialog box once you exit the dialog box, so that you only have one action tile.
-
Tim i tried your code and still no luck..Same problem variables not set.Same goes for the added precision.
It is set with this
(setq area-name (nth (atoi area-name) areanamelist)) before the cond and it will print the name on the command line but then it will not be inserted in the block.
This is what i got sofar and still cant figure out what is wrong.
(defun c:DDLabelArea (/ area1 area2 tab oba inspoint objarea)
(setq areanamelist(list
""
"Badkamer"
"Onbenoemde Ruimte"
"Toilet"
"Verblijfsgebied A"
"Verblijfsgebied B"
"Verblijfsgebied C"
"Verblijfsgebied D"
"Verblijfsgebied E"
"Verblijfsgebied F"
"Verblijfsgebied G"
"Verblijfsgebied H"
"Verblijfsgebied I"
"Verblijfsgebied J"
"Verkeersgebied"
))
(setq rotationlist(list "0" "45" "90" "135" "180" "225" "270" "315"))
(setq precisionlist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000" "0.000000" "0.0000000" "0.00000000"))
; ************************************************
(defun txtbox_infohulp ()
(alert
(strcat
"DDLabelArea 2006 Help.\n\n"
"Klik op OK om dit venster te sluiten.\n\n"
"Please report any problems you may have.\n\n"
)
)
)
; ************************************************
(setq DDLA (load_dialog "DDlabelarea"))
(new_dialog "DDlabelarea" DDLA)
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)
(start_list "rotationlist")
(mapcar 'add_list rotationlist)
(end_list)
(start_list "precisionlist")
(mapcar 'add_list precisionlist)
(end_list)
; ************************************************
(defun do_hatch ()
(if (= (get_tile "do-hatch") "1")(setq hatch-area "J"))
(if (/= (get_tile "do-hatch") "1")(setq hatch-area "N"))
)
; ************************************************
(set_tile "precisionlist" "2")
(action_tile "accept" "(setq area-name (get_tile \"areanamelist\"))(setq rotation (get_tile \"rotationlist\"))(setq precision (get_tile \"precisionlist\"))(setq suffix (get_tile \"suffixlist\"))(done_dialog 1)")
(action_tile "do-hatch" "(do_hatch)")
(action_tile "hulp" "(txtbox_infohulp)")
(action_tile "cancel" "(exit)(exit)")
(setq RET (start_dialog))}
(setvar "cmdecho" 1)
(setq fd (getvar "fielddisplay"))
(if (/= fd 1)(setvar"fielddisplay" 1))
(prompt "\nSelect Area Boundary (This must be an Closed Polyline): ")
(while (not (setq ss (ssget ":e:s" '((0 . "LWPOLYLINE") (70 . 1)))))
(prompt "\nSelected object is NOT an Closed LWPolyline.... "))
(setq area1 (ssname ss 0))
(setq area2 area1)
(setq tab (vlax-ename->vla-object area2))
(setq oba (vla-get-objectid tab))
(princ)
(setq inspoint (getpoint "\nPick label insertion point:"))
(princ)
(setq area-name (nth (atoi area-name) areanamelist))
(cond
(
(and (= suffix "suffix1")(= precision "0") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix1")(= precision "0.0") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix1")(= precision "0.00") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix1")(= precision "0.000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix1")(= precision "0.0000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix1")(= precision "0.00000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix1")(= precision "0.000000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix1")(= precision "0.0000000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix1")(= precision "0.00000000")(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps[, m2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0.0") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0.00") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0.000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0.0000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0.00000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0.000000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0.0000000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix2")(= precision "0.00000000")(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps[, M2]%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0.0") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0.00") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0.000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0.0000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0.00000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0.000000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0.0000000") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps%ds44%ct8[1e-006]\">%"))))
(
(and (= suffix "suffix3")(= precision "0.00000000")(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps%ds44%ct8[1e-006]\">%"))))
;((= suffix "suffix1") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps[, m2]%ds44%ct8[1e-006]\">%")))
;((= suffix "suffix2") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, M2]%ds44%ct8[1e-006]\">%")))
;((= suffix "suffix3") (setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps%ds44%ct8[1e-006]\">%")))
((= area-name "Badkamer") (setq anghatch "135")(setq dblhatch "n"))
((= area-name "Toilet") (setq anghatch "135")(setq dblhatch "n"))
((= area-name "Verblijfsgebied A")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied B")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied C")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied D")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied E")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied F")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied G")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied H")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied I")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied J")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verkeersgebied") (setq anghatch "45") (setq dblhatch "y"))
)
(setvar "attdia" 0)
(setvar "attreq" 1)
(setq schaal (rtos(getvar "userr1")))
(command "-insert" "oppervlakte" "s" schaal inspoint (nth (atoi rotation) rotationlist) (nth (atoi area-name) areanamelist) objarea )
(setq hatchobjects(entlast))
(command "-layer" "s" "00---0-a_Arceer" "")
(print anghatch)
(print dblhatch)
(setq area-name (nth (atoi area-name) areanamelist))
;;(if (= hatch-area "J")(command "-bhatch" "s" area1 hatchobjects "" "p" "u" "45" "150" "n" ""))
(if (= hatch-area "J")(command "-bhatch" "s" area1 hatchobjects "" "p" "u" anghatch "150" dblhatch ""))
(setq hatch-area nil )
(setq hatchobjects nil )
(setq suffix nil )
(setq anghatch nil )
(setq dblhatch nil)
(command "-layer" "s" "0" "")
(setvar "attdia" 1)
(setvar "attreq" 1)
(princ)
)
DDlabelarea : dialog {value = "DDLabelArea 2006";
:row{
:boxed_row {label = "< Select Area Name >";
:popup_list {key = "areanamelist"; width = 25;}}
:boxed_row {label = "< Precision >";
:popup_list {key = "precisionlist";width = 1;}}
}
:spacer{height=1;}
:boxed_radio_row{label="< Suffix >";key="suffixlist";
:radio_button {label="m2" ;key="suffix1" ;mnemonic = "2";value = "1";}
:radio_button {label="M2" ;key="suffix2" ;mnemonic = "M";}
:radio_button {label="None" ;key="suffix3" ;mnemonic = "N";}
}
:spacer{height=1;}
:row{
:boxed_row {label = "< Rotation >";
:popup_list {key = "rotationlist" ; width = 1; }}
:boxed_row {label = "< Hatch > " ;
:spacer{height=1;}
:toggle {label = "Yes"; key = "do-hatch";mnemonic = "Y";}}}
:row{
:button {label="Sel. Object";width =10;height = 1.4;key="accept";mnemonic = "S";}
:button {label="Help" ;width =10;height = 1.4;key="hulp" ;mnemonic = "H";}
:spacer {height=5;}
cancel_button;
}
}
-
Please study this, as it works.
(defun c:DDLabelArea (/ areanamelist rotationlist precisionlist ddla area-name rotation precision suffix
fd ss area1 area2 tab oba ret inspoint objarea anghatch dblhatch schaal hatchobject)
(setq areanamelist(list
""
"Badkamer"
"Onbenoemde Ruimte"
"Toilet"
"Verblijfsgebied A"
"Verblijfsgebied B"
"Verblijfsgebied C"
"Verblijfsgebied D"
"Verblijfsgebied E"
"Verblijfsgebied F"
"Verblijfsgebied G"
"Verblijfsgebied H"
"Verblijfsgebied I"
"Verblijfsgebied J"
"Verkeersgebied"
))
(setq rotationlist(list "0" "45" "90" "135" "180" "225" "270" "315"))
(setq precisionlist (list "0" "0.0" "0.00" "0.000" "0.0000" "0.00000" "0.000000" "0.0000000" "0.00000000"))
; ************************************************
(defun txtbox_infohulp ()
(alert
(strcat
"DDLabelArea 2006 Help.\n\n"
"Klik op OK om dit venster te sluiten.\n\n"
"Please report any problems you may have.\n\n"
)
)
)
; ************************************************
(setq DDLA (load_dialog "DDlabelarea"))
(new_dialog "DDlabelarea" DDLA)
(start_list "areanamelist")
(mapcar 'add_list areanamelist)
(end_list)
(start_list "rotationlist")
(mapcar 'add_list rotationlist)
(end_list)
(start_list "precisionlist")
(mapcar 'add_list precisionlist)
(end_list)
; ************************************************
(defun do_hatch ()
(if (= (get_tile "do-hatch") "1")(setq hatch-area "J"))
(if (/= (get_tile "do-hatch") "1")(setq hatch-area "N"))
)
; ************************************************
(set_tile "precisionlist" "2")
(action_tile "accept" "(setq area-name (get_tile \"areanamelist\"))(setq rotation (get_tile \"rotationlist\"))(setq precision (get_tile \"precisionlist\"))(setq suffix (get_tile \"suffixlist\"))(done_dialog 1)")
(action_tile "do-hatch" "(do_hatch)")
(action_tile "hulp" "(txtbox_infohulp)")
(action_tile "cancel" "(exit)(exit)")
(setq RET (start_dialog))}
(setvar "cmdecho" 1)
(setq fd (getvar "fielddisplay"))
(if (/= fd 1)(setvar"fielddisplay" 1))
(prompt "\nSelect Area Boundary (This must be an Closed Polyline): ")
(while (not (setq ss (ssget ":e:s" '((0 . "LWPOLYLINE") (70 . 1)))))
(prompt "\nSelected object is NOT an Closed LWPolyline.... "))
(setq area1 (ssname ss 0))
(setq area2 area1)
(setq tab (vlax-ename->vla-object area2))
(setq oba (vla-get-objectid tab))
(princ)
(setq inspoint (getpoint "\nPick label insertion point:"))
(princ)
(setq area-name (nth (atoi area-name) areanamelist))
(setq rotation (nth (atoi rotation) rotationlist))
(setq precision (nth (atoi precision) precisionlist))
(cond
(
(and (= suffix "suffix1")(= precision "0"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix1")(= precision "0.0"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix1")(= precision "0.00"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix1")(= precision "0.000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix1")(= precision "0.0000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix1")(= precision "0.00000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix1")(= precision "0.000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix1")(= precision "0.0000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix1")(= precision "0.00000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps[, m2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0.0"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0.00"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0.000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0.0000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0.00000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0.000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0.0000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix2")(= precision "0.00000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps[, M2]%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr0%ps%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0.0"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr1%ps%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0.00"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr2%ps%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0.000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr3%ps%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0.0000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr4%ps%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0.00000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr5%ps%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0.000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr6%ps%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0.0000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr7%ps%ds44%ct8[1e-006]\">%"))
)
(
(and (= suffix "suffix3")(= precision "0.00000000"))
(setq objarea (strcat "%<\\AcObjProp Object(%<\\_ObjId " (rtos oba 2 0) ">%).Area \\f \"%lu2%pr8%ps%ds44%ct8[1e-006]\">%"))
)
)
(cond
((= area-name "Badkamer") (setq anghatch "135")(setq dblhatch "n"))
((= area-name "Toilet") (setq anghatch "135")(setq dblhatch "n"))
((= area-name "Verblijfsgebied A")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied B")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied C")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied D")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied E")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied F")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied G")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied H")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied I")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verblijfsgebied J")(setq anghatch "45") (setq dblhatch "n"))
((= area-name "Verkeersgebied") (setq anghatch "45") (setq dblhatch "y"))
)
(setvar "attdia" 0)
(setvar "attreq" 1)
(setq schaal
(rtos
(if (equal (getvar "userr1") 0.0)
1.0
(getvar "userr1")
)
)
)
(command "-insert" "oppervlakte" "s" schaal inspoint (nth (atoi rotation) rotationlist) (nth (atoi area-name) areanamelist) objarea )
;(command "-insert" "det-bub" "s" schaal inspoint (nth (atoi rotation) rotationlist) (nth (atoi area-name) areanamelist) objarea )
(setq hatchobjects(entlast))
(command "-layer" "n" "00---0-a_Arceer" "")
(print (nth (atoi area-name) areanamelist))
(print objarea)
(setq area-name (nth (atoi area-name) areanamelist))
;;(if (= hatch-area "J")(command "-bhatch" "s" area1 hatchobjects "" "p" "u" "45" "150" "n" ""))
(if (= hatch-area "J")(command "-bhatch" "s" area1 hatchobjects "" "p" "u" anghatch "150" dblhatch ""))
(setq hatch-area nil )
(setq hatchobjects nil )
(setq suffix nil )
(setq anghatch nil )
(setq dblhatch nil)
(command "-layer" "s" "0" "")
(setvar "attdia" 1)
(setvar "attreq" 1)
(princ)
)
-
Thanks Tim
First of all i want to thank you for the tremendous amount of time and patience.
I studied your code and off course tried it and these are my findings.It is not entirely working but getting there.
The area-name is not inserted in the block and when changing the insertion angle it is not working.(Block not inserted)
But changing this:
princ)
(setq inspoint (getpoint "\nPick label insertion point:"))
(princ)
(setq area-name (nth (atoi area-name) areanamelist))
(setq rotation (nth (atoi rotation) rotationlist))
(setq precision (nth (atoi precision) precisionlist))
In to this:
(princ)
(setq inspoint (getpoint "\nPick label insertion point:"))
(princ)
;;(setq area-name (nth (atoi area-name) areanamelist))
;;(setq rotation (nth (atoi rotation) rotationlist))
(setq precision (nth (atoi precision) precisionlist))
The area-name is inserted but then the area is not hatched.Because variable anghatch and dblhatch are not set.!!!
Modified after getting an idea.....Tried changing variable area-name into areaname (see piece of code below)
(princ)
(setq inspoint (getpoint "\nPick label insertion point:"))
(princ)
(setq areaname (nth (atoi area-name) areanamelist))
;;(setq rotation (nth (atoi rotation) rotationlist))
(setq precision (nth (atoi precision) precisionlist))
And also changed this:
(cond
((= areaname "Badkamer") (setq anghatch "135")(setq dblhatch "n"))
((= areaname "Toilet") (setq anghatch "135")(setq dblhatch "n"))
((= areaname "Verblijfsgebied A")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied B")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied C")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied D")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied E")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied F")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied G")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied H")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied I")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verblijfsgebied J")(setq anghatch "45") (setq dblhatch "n"))
((= areaname "Verkeersgebied") (setq anghatch "45") (setq dblhatch "y"))
)
And sofar i got it finally working the way i want it.
So once again Tim thank you for helping me with this.It has been a lot of fun.....
-
Okay. Attach a lisp file, dcl file and a drawing that I can test it on when I get to work tomorrow. It worked on my computer at work, so let me try the one you are using, and can go from there.
-
Here are the files you requested.
-
It worked just fine for me. All I had to do was change the value of "userr1", as the 20 scaled the block to much. Once I changed that to one, it inserted the block the way it looked when you attached it.
Is it not supposed to look that way? I don't know (most likey don't have the program) to make a video, or I would to show you that it works.
-
Tim it is working for me also and the way i want it work.I think you missed the last part of my previous post.
-
Tim it is working for me also and the way i want it work.I think you missed the last part of my previous post.
Yup I did. I'm glad you got it working the way you want it to, and I hope you learned a lot from this experience also. Have fun. :-)
-
I learned an awful lot and maybe i can learn one thing more.When you hit the escape button it isn't looking very nice.
Is there a way to make it nicer.?
-
You will have to code your cancel button in your dcl file better. Here is what one of mine looks like.
: button { label = "Cancel"; key = "cancel"; is_cancel = true; }
What you want is the "is_cancel" area. AFAIK, this is telling the program that if escape is hit, then use the button that is labeled "is_cancel = true". Plus in your code, you have when cancel is hit to exit. I would set it up so that "Select Polyline" is (done_dialog 1) and the cancel button is (done_dialog 0), and then check the (start_dialog) and if it equals 1 then proceed with the lisp, but if not then just exit. Example
(if (equal (start_dialog) 1)
(progn
....... do your code here ...
)
(prompt "\n Function canceled.")
)
-
I can 't try it now but this is what i created.
DDlabelarea : dialog {value = "DDLabelArea 2006";
:row{
:boxed_row {label = "< Select Area Name >";
:popup_list {key = "areanamelist"; width = 25;}}
:boxed_row {label = "< Precision >";
:popup_list {key = "precisionlist";width = 1;}}
}
:spacer{height=1;}
:boxed_radio_row{label="< Suffix >";key="suffixlist";
:radio_button {label="m2" ;key="suffix1" ;mnemonic = "2";value = "1";}
:radio_button {label="M2" ;key="suffix2" ;mnemonic = "M";}
:radio_button {label="None" ;key="suffix3" ;mnemonic = "N";}
}
:spacer{height=1;}
:row{
:boxed_row {label = "< Rotation >";
:popup_list {key = "rotationlist" ; width = 1; }}
:boxed_row {label = "< Hatch > " ;
:spacer{height=1;}
:toggle {label = "Yes"; key = "do-hatch";mnemonic = "Y";}}}
:row{
:button {label="Sel. Object";width =10;height = 1.4;key="accept";mnemonic = "S";}
:button {label="Help" ;width =10;height = 1.4;key="hulp" ;mnemonic = "H";}
:button {label="Cancel" ;width =10;height = 1.4;key="cancel"; is_cancel = true;mnemonic = "C"; }
:spacer {height=5;}
}
}
The DCL is the easy part but now the (very) hard part.This what i changed.
(if (equal (start_dialog) 1)
(progn
(set_tile "precisionlist" "2")
(action_tile "accept" "(setq area-name (get_tile \"areanamelist\"))(setq rotation (get_tile \"rotationlist\"))(setq precision (get_tile \"precisionlist\"))(setq suffix (get_tile \"suffixlist\"))(done_dialog 1)")
(action_tile "do-hatch" "(do_hatch)")
(action_tile "hulp" "(txtbox_infohulp)")
)
(action_tile "cancel" "(done_dialog 0)")(prompt "\n Function canceled.")
(setq RET (start_dialog))
-
Here is how you should change the lisp portion.
-
Thanks again Tim.
-
Thanks again Tim.
You're welcome [insert real name here]. :roll:
-
I have another question. which i think is almost an mission impossible.
When browsing through my drop downlist i want when i am on a certain area-name the hatch button immediately to be greyed out. Is this possible..?
-
You can do that. Set up an action tile for the list, and have it check the value (off the top of my head, $reason) and if it's the one, then mode tile the hatch button (I would set it to not hatch also, and mode tile it out). I don't have time to show you code, but this is the way. Hope I wrote it clear.
-
This is what i understand ( i think).
Your suggestion is that the default hatch button is always greyed out,and this toggle button will be available when i immediately choose another area-name in the drop down list which will unlock the toggel button,This is a though one so the question is how (when you got the time) to do this.
-
Here is a small example to show you what I'm talking about. Here is the lisp portion.
(defun c:Testing (/ tmpList DiaLoad)
(setq tmpList '("test" "test1" "Grey Out"))
(setq DiaLoad (load_dialog "Test.dcl"))
(if (not (new_dialog "Testing" DiaLoad))
(exit)
)
(start_list "LsBox" 3)
(mapcar 'add_list tmpList)
(end_list)
(action_tile "LsBox" "(if (= (atoi $value) (vl-position \"Grey Out\" tmpList)) (mode_tile \"Tog\" 1) (mode_tile \"Tog\" 0))")
(action_tile "accept" " (done_dialog 1)")
(start_dialog)
)
Here is the dcl portion, save as "Test.dcl".
Testing : dialog { label = "Testing grey out" ;
: boxed_row {
: list_box { key = "LsBox" ; }
: toggle { key = "Tog" ;}
}
: row {
: button { label = "Done" ; key = "accept" ; is_cancel = true ; }
}
}
-
Unexpectedly i had a week off.
It works great, so thanks again Tim,, but how to add one more to grey-out list.
This aint the the way i found out.
(vl-position \"Grey Out\" \"test\" tmpList))
-
You would have to use an or statement. Something like.
(if
(or
(= (atoi $value) (vl-position \"Grey Out\" tmpList))
(= (atoi $value) (vl-position \"test\" tmpList))
...
And you're welcome.
-
Thanks Tim you're a lifesaver.
-
You're welcome.
-
To add more candy i added an image (for a slide) in the dcl and i immediately want the slide to change when browsing through my areaname drop downlist.
So when arename is toilet i want it to show slide1
and when arename is bathroom i want it to show slide2 and so on..
How can this be done.?
-
To add more candy i added an image (for a slide) in the dcl and i immediately want the slide to change when browsing through my areaname drop downlist.
So when arename is toilet i want it to show slide1
and when arename is bathroom i want it to show slide2 and so on..
How can this be done.?
Don't know. I have never used slides for a dcl. Maybe it is time to start a new thread with request for help on this subject.
-
To add more candy i added an image (for a slide) in the dcl and i immediately want the slide to change when browsing through my areaname drop downlist.
So when arename is toilet i want it to show slide1
and when arename is bathroom i want it to show slide2 and so on..
How can this be done.?
I have modified the following routine to do this. Reads a text file listing the slide name. Then it places the slide from the slide library
as selected from the list box. There are many ways to do this, but I have found Lintang's to be the best.
Original routine "HotBlocks" by Lintang Darudjati.
Gary
-
Don't know. I have never used slides for a dcl. Maybe it is time to start a new thread with request for help on this subject.
[/quote]
But thanks anyway and for all the help and leasons.
And Gary i will check your suggestion.