Make an object's properties current / Match properties ?

Hi there,

I'm after a command to set the current entity creation properties by
selecting an object.

Similar in principle to the 'matchprop' command, but to select a source
object for which the properties are inherited into the current settings.

I used to have a lisp that did it for release 14 years ago, but have lost
any reference to it through changes of setups and upgrades. I've searched
several cad websites but havent found reference to a similar command.

Any help would be much appreciated =)

Thanks,

Peter

 

May be in Expresstools 'laymch'

 

Peter,
Can you go more into depth (maybe give an example) as to what you would like to do?
Andrew

 

Here is a variant of a routine I got from a friend back in 1990...
It is called XPR (Change properties). Pick the item that you want to change, then pick an entity with the desired properties. It does not set the entity as a current layer however.
;*** ICES ***
(defun c:Xpr (/ a1 a2 n index b2 l2 c2 lt2 b1 l1 c1 lt1 colr ltyp)
(setvar "CMDECHO" 0)
(graphscr)
(prompt "\nSelect stuff to be changed: ")
(setq a1 (ssget))
(prompt "\nPick item to match properties: ")
(setq a2 (entsel))
(setq n (sslength a1))
(setq index 0)
(setq b2 (entget (car a2)))

(setq l2 (assoc 8 b2))
(setq c2 (assoc 62 b2))
(setq lt2 (assoc 6 b2))

;CONDITION ONE
(if (and (/= c2 nil)(/= lt2 nil))
(progn
(setq colr (itoa (cdr c2)))
(setq ltyp (cdr lt2))
(command "change" a1 "" "p" "la" (cdr l2) "C" colr "LT" ltyp "")
));END PROGN,IF

;CONDITION TWO
(if (and (/= c2 nil)(= lt2 nil))
(progn
(setq colr (itoa (cdr c2)))
(command "change" a1 "" "p" "la" (cdr l2) "C" colr "lt" "BYLAYER" "")
));END PROGN,IF

;CONDITION THREE
(if (and (= c2 nil)(/= lt2 nil))
(progn
(setq ltyp (cdr lt2))
(command "change" a1 "" "P" "la" (cdr l2) "C" "BYLA" "LT" ltyp "")
));END PROGN,IF

;CONDITION FOUR
(if (and (= c2 nil)(= lt2 nil))
(progn
(command"change" a1 "" "p" "la" (cdr l2) "C" "BYLA" "LT" "BYLAYER" "")
));END PROGN,IF

)


Susan Hunter

 

Andrew,

The command I am looking for would make a selected object's properties
current.

For example:

.... if you select a line that has the properties, colour 1, layer 0 and
dashed linetype, then your current colour would be set at 1, layer at 0 and
current linetype dashed.

.... similarly, if you selected a piece of text, colour 1, layer 0,
continuous linetype and txt.shx font at 50 height, then your current
settings would be as mentioned with current the text style and text height
changed if it was previously different.

The object of the command is to CREATE entities with properties of the
previously selected item. So, it's a step away from the standard autocad
command of 'matchprop', which modifies entities to match the previous
selection.

Thanks again for any suggestions.

Peter



Peter,
Can you go more into depth (maybe give an example) as to what you would like
to do?
Andrew

 

Thanks for the input Susan. That command works well, but is not exactly what
I'm after. Within acad 2002 the standard command 'matchprop' similarly does
what your 'xpr' command does .. perhaps a bit better as it modifies/matches
things like text style as well.

I'm after a command to set the current properties from a selected item.
Following that, and future objects CREATED, would have the same properties
as the previous selection.

Peter


Here is a variant of a routine I got from a friend back in 1990...
It is called XPR (Change properties). Pick the item that you want to change,
then pick an entity with the desired properties. It does not set the entity
as a current layer however.
;*** ICES ***
(defun c:Xpr (/ a1 a2 n index b2 l2 c2 lt2 b1 l1 c1 lt1 colr ltyp)
(setvar "CMDECHO" 0)
(graphscr)
(prompt "\nSelect stuff to be changed: ")
(setq a1 (ssget))
(prompt "\nPick item to match properties: ")
(setq a2 (entsel))
(setq n (sslength a1))
(setq index 0)
(setq b2 (entget (car a2)))

(setq l2 (assoc 8 b2))
(setq c2 (assoc 62 b2))
(setq lt2 (assoc 6 b2))

;CONDITION ONE
(if (and (/= c2 nil)(/= lt2 nil))
(progn
(setq colr (itoa (cdr c2)))
(setq ltyp (cdr lt2))
(command "change" a1 "" "p" "la" (cdr l2) "C" colr "LT" ltyp "")
));END PROGN,IF

;CONDITION TWO
(if (and (/= c2 nil)(= lt2 nil))
(progn
(setq colr (itoa (cdr c2)))
(command "change" a1 "" "p" "la" (cdr l2) "C" colr "lt" "BYLAYER" "")
));END PROGN,IF

;CONDITION THREE
(if (and (= c2 nil)(/= lt2 nil))
(progn
(setq ltyp (cdr lt2))
(command "change" a1 "" "P" "la" (cdr l2) "C" "BYLA" "LT" ltyp "")
));END PROGN,IF

;CONDITION FOUR
(if (and (= c2 nil)(= lt2 nil))
(progn
(command"change" a1 "" "p" "la" (cdr l2) "C" "BYLA" "LT" "BYLAYER" "")
));END PROGN,IF

)


Susan Hunter

 

This might be pretty hard to do. Certainly all the properties you want are
all settable with (setvar) in lisp, but in a way I think they're NOT all
extractable from a selected drawing entity. Some certainly are, namely the
ones that everything has, like the Layer:

(setq objlayer (cdr (assoc 8 (entget (car (entsel)))))); to save the Layer
of a selected object, and then later:
(setvar "CLAYER" objlayer); to make that the current Layer for subsequent
objects.

But some of these properties are NOT stored with the entity IF they're
default values. For example, assoc 370 is the lineweight of a line, but
ONLY if it's assigned one other than Bylayer -- if it's Bylayer, there is NO
assoc 370 entry in the (entget) listing, so I assume you can't use it to set
the value of CELWEIGHT (A2K4 and later). Maybe there's a way to ask WHETHER
or not there's an assoc 370 value, and if not, then set CELWEIGHT to -1 for
Bylayer; otherwise, set it to whatever that extracted value is.

But I know some assoc-list values mean different things for different kinds
of entities (e.g. assoc 10 & 11, which are endpoints for lines, but various
kinds of insertion and orientation points for text at different
justifications). Maybe none of the Current-Properties ones that you want
are ambiguous like that, but that might take some careful evaluation.

Kent Cooper, AIA


...

 

Well, duh, there is of course an easy way to find out whether there's a
certain assoc value or not, by checking whether it's nil. So you could do:

(setq objprops (entget (car (entsel)))); to get the association list for a
selected object.

And then to set the current lineweight:

(setq objlweight (cdr (assoc 370 objprops))); to save the object's
lineweight [even if it doesn't have one assigned].
(if (= objlweight nil) (setvar "CELWEIGHT" -1) (setvar "CELWEIGHT"
objlweight); to make its assigned lineweight the current one, or make
"Bylayer" [-1]current if the object has no assigned lineweight.

Then there's the question of how you make one routine account for different
kinds of objects. If you want it to make the text style of a selected
object current, IF the selected object IS a piece of text, what does it do
when you're aiming to match some other kind of object, and the selected
object has no qualities related to text at all? Maybe if there's no text
style value (e.g. when you pick a line), you can have it set the current
text style to Standard, even though what you want to make isn't going to be
text. I hope you don't run into any assoc values that have different
meanings for different object types, because then you'd have to look at both
the object type and the assoc value, in combination, to figure out what to
set, and to what value.

I figure you've got a pretty long list of properties to account for, to
cover all bases for all kinds of entities, and a lot of checking what
default values are, so you can set them that way when the selected object
doesn't have an assigned override value.

Kent Cooper, AIA


...
....

....

 

Peter,
I use matchprop a lot and it works almost too well sometimes. For instance, it will happily rotate text to match-when sometimes all that is wanted is color, layer, linetype, etc. I use XPR when that's the case and to keep from having to set layers when working on a complex design. Old habits do die hard-I use it so automatically (it is in my Acad2000doc.lsp file). I am still biased toward noun/verb input, probably as a result of using an HP calculator.
When you get what you need, it will be very handy. Thanks for the reply.
Susan

 

Here's something to get you started at least.
It extracts the properties common to most objects...
color, layer, linetype, linetypescale, lineweight
and sets the current system variables to those properites.
Additionally, if the entity is of type...
text, dimension, lwpolyline
it sets additional system variables (dimstyle, textstyle, constant width, etc.) to those properties.
You could easily add conditional statements for other objects and set variables according to their specific properties.
Error-handling is non-existent.
Just a start...

Code:

(defun c:ChangeSettings ( / )

;; load activex features
(vl-load-com)
;; user selects entity
(setq e (car (entsel "\nSelect entity to extract properties: ")))

;; if user selected an entity...
(if e
(progn
;; get general properties
(setq obj (vlax-ename->vla-object e) ; activex object
objName (strcase (vla-get-objectname obj)) ; type
objLayer (vla-get-layer obj) ; layer
objColor (itoa (vla-get-color obj)) ; color (as string)
objLinetype (vla-get-linetype obj) ; linetype
objLinetypeScale (vla-get-linetypescale obj) ; linetype scale
objLineweight (vla-get-lineweight obj)) ; lineweight

;; set system variables to match general properties of object
(setvar "CLAYER" objLayer)
(setvar "CECOLOR" objColor)
(setvar "CELTYPE" objLinetype)
(setvar "CELTSCALE" objLinetypeScale)
(setvar "CELWEIGHT" objLineweight)

;; set type-specific properties
(cond

;; text or mtext
((or (= "ACDBTEXT" objName)
(= "ACDBMTEXT" objName))
;; get style, thickness
(setq objTextStyle (vla-get-stylename obj)
objThickness (vla-get-thickness obj))
;; set style, thickness
(setvar "TEXTSTYLE" objTextStyle)
(setvar "THICKNESS" objThickness)
)

;; dimension
((= "ACDBDIM" (substr objName 1 7))
;; get style, overall scale
(setq objDimStyle (vla-get-stylename obj)
objDimScale (vla-get-scalefactor obj))
;; set style, overall scale
(setvar "DIMSTYLE" objDimStyle)
(setvar "DIMSCALE" objDimScale)
)

;; lightweight polyline
((= "ACDBLWPOLYLINE")
;; get constant width, thickness
(setq objWidth (vla-get-constantwidth obj)
objThickness (vla-get-thickness obj))
;; set constant width, thickness
(setvar "PLINEWID" objWidth)
(setvar "THICKNESS" objThickness)
)

); cond

;; release activex object
(vlax-release-object obj)

); progn
); if
(princ)
); defun

 

Thats a great start Andy.

Thanks,

Peter


Here's something to get you started at least.
It extracts the properties common to most objects...
color, layer, linetype, linetypescale, lineweight
and sets the current system variables to those properites.
Additionally, if the entity is of type...
text, dimension, lwpolyline
it sets additional system variables (dimstyle, textstyle, constant width,
etc.) to those properties.
You could easily add conditional statements for other objects and set
variables according to their specific properties.
Error-handling is non-existent.
Just a start...

Code:

(defun c:ChangeSettings ( / )

;; load activex features
(vl-load-com)
;; user selects entity
(setq e (car (entsel "\nSelect entity to extract properties: ")))

;; if user selected an entity...
(if e
(progn
;; get general properties
(setq obj (vlax-ename->vla-object e) ; activex object
objName (strcase (vla-get-objectname obj)) ; type
objLayer (vla-get-layer obj) ; layer
objColor (itoa (vla-get-color obj)) ; color (as string)
objLinetype (vla-get-linetype obj) ; linetype
objLinetypeScale (vla-get-linetypescale obj) ; linetype scale
objLineweight (vla-get-lineweight obj)) ; lineweight

;; set system variables to match general properties of object
(setvar "CLAYER" objLayer)
(setvar "CECOLOR" objColor)
(setvar "CELTYPE" objLinetype)
(setvar "CELTSCALE" objLinetypeScale)
(setvar "CELWEIGHT" objLineweight)

;; set type-specific properties
(cond

;; text or mtext
((or (= "ACDBTEXT" objName)
(= "ACDBMTEXT" objName))
;; get style, thickness
(setq objTextStyle (vla-get-stylename obj)
objThickness (vla-get-thickness obj))
;; set style, thickness
(setvar "TEXTSTYLE" objTextStyle)
(setvar "THICKNESS" objThickness)
)

;; dimension
((= "ACDBDIM" (substr objName 1 7))
;; get style, overall scale
(setq objDimStyle (vla-get-stylename obj)
objDimScale (vla-get-scalefactor obj))
;; set style, overall scale
(setvar "DIMSTYLE" objDimStyle)
(setvar "DIMSCALE" objDimScale)
)

;; lightweight polyline
((= "ACDBLWPOLYLINE")
;; get constant width, thickness
(setq objWidth (vla-get-constantwidth obj)
objThickness (vla-get-thickness obj))
;; set constant width, thickness
(setvar "PLINEWID" objWidth)
(setvar "THICKNESS" objThickness)
)

); cond

;; release activex object
(vlax-release-object obj)

); progn
); if
(princ)
); defun

 

Susan,

I have a command virtually identical to your XPR which I have used for quite
some time as an alternative to Matchprop, which as you say sometimes works
too well. Slight derivations of similar commands become second nature, even
though they can seem to be more or less the alternative. The whole point of
being able to customise i suppose.

Interesting that you refer to noun/verb input as a probably result of using
a RPN HP calculator. Although my boss who is a RPN diehard, he definitely
isn't biased towards noun/verb input in cad.

AndyWatson has put down a good start which works well. Give it a go.

Peter


Peter,
I use matchprop a lot and it works almost too well sometimes. For instance,
it will happily rotate text to match-when sometimes all that is wanted is
color, layer, linetype, etc. I use XPR when that's the case and to keep from
having to set layers when working on a complex design. Old habits do die
hard-I use it so automatically (it is in my Acad2000doc.lsp file). I am
still biased toward noun/verb input, probably as a result of using an HP
calculator.
When you get what you need, it will be very handy. Thanks for the reply.
Susan