match elevation of any object lisp

[Anonymous]

I have this code (by lee Mac) to match polyline Elevation, colour ect, is there a way to update it to match elevation of any Autocad object, text block ect..

I really appreciate any help.

Thanks

Allan

(defun c:pmtch  (/ ent cObj lay col lt lts lw el ss)
  (vl-load-com)
  (if (and (setq ent (car (entsel "\nSelect Polyline to Match: ")))
           (eq "AcDbPolyline" (vla-get-ObjectName
                                (setq cObj (vlax-ename->vla-object ent)))))
    (progn
      (setq lay (vla-get-layer cObj)
            col (vla-get-color cObj)
            lt  (vla-get-linetype cObj)
            lts (vla-get-linetypescale cObj)
            lw  (vla-get-lineweight cObj)
            el  (vla-get-Elevation cObj))
      (if (setq ss (ssget (list (cons 0 "*POLYLINE")
                                (if (getvar "CTAB")
                                  (cons 410 (getvar "CTAB"))
                                  (cons 67 (- 1 (getvar "TILEMODE")))))))
        (progn (vlax-for lay  (vla-get-layers
                                (vla-get-ActiveDocument
                                  (vlax-get-acad-object)))
                 (vla-put-lock lay :vlax-false))
               (foreach Obj  (mapcar 'vlax-ename->vla-object
                                     (vl-remove-if 'listp
                                       (mapcar 'cadr (ssnamex ss))))
                 (vla-put-elevation Obj el)
                 (vla-put-layer Obj lay)
                 (vla-put-color Obj col)
                 (vla-put-linetype Obj lt)
                 (vla-put-linetypescale Obj lts)
                 (vla-put-lineweight Obj lw)))
        (princ "\n<!> No Polylines Selected <!>")))
    (princ "\n<!> No Polyline Selected <!>"))
  (princ))

[stevor]

No guess as to your objective,

but a simple modification to Lee Mac's routine

may give a start:

comment out the 2nd qualifying argunet of the initial 'and:'

  (if (and (setq ent (car (entsel "\nSelect Polyline to Match: ")))
             ;  (eq "AcDbPolyline" (vla-get-ObjectName
             ;     (setq cObj (vlax-ename->vla-object ent))))
      ) ; and
    (progn

[stevor]

Better mod that mod to:

  (if (and (setq ent (car (entsel "\nSelect Polyline to Match: ")))
           (setq cObj (vlax-ename->vla-object ent))
           ; (eq "AcDbPolyline" (vla-get-ObjectName cObj ))
      ) ; and
    (progn

in order to use the variable 'cObj ' in the subsequent code.

Also, since Lee's routine is to modify "*POLYLINE" entities,

all the code for entity changes must be made to match the selected entity,

or, reduced to whatever you actually want to do.

[stevor]

And a stab at a routine: ; derivative of LeeMac's 14th Apr 2009 (defun c:pmtch (/ ent ObjChg lay col lt lts lw el ss) (vl-load-com) (if (and (setq ent (car (entsel "\n Sel Change Obj to Change Elev: "))) (setq ObjChg (vlax-ename->vla-object ent)) (setq ElChg (vla-get-Elevation ObjChg) layc (vla-get-layer ObjChg) ) (princ"\n Layer: ")(princ layc) (princ", elev: ")(prin1 ElChg) (setq ent (car (entsel "\n Sel Ref Obj for Refence Elev: "))) (setq ObjRef (vlax-ename->vla-object ent)) (setq ElRef (vla-get-Elevation ObjRef) layr (vla-get-layer ObjRef) ) (princ"\n Ref Layer: ")(princ layr) (princ", New elev: ")(prin1 ElRef) ) ; and (progn (vlax-for layc (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object)) ) (vla-put-lock layc :vlax-false) ) ; for ; do something (princ" Put: ")(prin1 ObjChg) (vla-put-elevation ObjChg ElRef) ) (princ "\n<!> No Object Selected <!>") ) (princ) )

[Kent1Cooper]

---

@stevor wrote:

....

           (setq cObj (vlax-ename->vla-object ent))
....

in order to use the variable 'cObj ' in the subsequent code.

....

---

It's not that simple.  The way it uses 'cObj' subsequently is to get [among other things] its Elevation VLA Property using (vla-get-Elevation cObj), and apply that to other objects.  That works if it's a Polyline, and the things you apply its elevation to are also Polylines.  But it doesn't work if either the thing you want to match to, or the thing(s) you want matched to it, are any of a whole variety of other things that don't have an Elevation Property [Text, Circle, Arc, Block, etc., etc.].

It would be necessary to get the elevation differently from different entity types, and also to impose it differently on different entity types.  For many [including all of those just mentioned], if in the WCS, it could be taken from the Z coordinate of the (assoc 10) entry in their entity data.  But I imagine there are exceptions to that.  In VLA Property terms, that is called different things for different entity types [InsertionPoint for Text and Blocks, Center for Circles and Arcs, etc.].  And even ignoring the possibility of different Coordinate Systems, what about something like a Line, that can have different elevations at each end?  What elevation should be matched -- the start, the end, the average [midpoint]?  I don't even want to think about a 3DPolyline or non-planar Spline.

I think either a breakdown of all entity types, categorized by how their elevation can be extracted and how a different one can be imposed, would be needed, or the OP would have to settle for a routine that can work with only some limited set of entity types, which could greatly simplify the code.

[paullimapa]

Or go back to the standard AutoCAD CHANGE command for the Elevation Property.

Once the Elevation EL is retrieved from the selected Pline, use the Change command on the Selection Set SS:

(command"_.CHANGE" ss "" "_P" "_E" EL)

But like Kent said, this will not work on objects like 3dPlines or Lines with different Z end points.

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales |Exchange App Store

[PADDYDELMAR]

Great little routine. I cant get the lineweight to work for this. on a polyline it is called global width, i think. is there a way to modify this routine to include that?

[Kent1Cooper]

---

@PADDYDELMAR wrote:

.... I cant get the lineweight to work for this. on a polyline it is called global width, i think. is there a way to modify this routine to include that?

---

If you're always talking about Polylines with global width, try adding these lines [untested]:

....
            lw  (vla-get-lineweight cObj)
            cw (vla-get-ConstantWidth cObj)
            el  (vla-get-Elevation cObj))
      (if (setq ss (ssget (list (cons 0 "*POLYLINE")
                                (if (getvar "CTAB")
                                  (cons 410 (getvar "CTAB"))
                                  (cons 67 (- 1 (getvar "TILEMODE")))))))
        (progn (vlax-for lay  (vla-get-layers
                                (vla-get-ActiveDocument
                                  (vlax-get-acad-object)))
                 (vla-put-lock lay :vlax-false))
               (foreach Obj  (mapcar 'vlax-ename->vla-object
                                     (vl-remove-if 'listp
                                       (mapcar 'cadr (ssnamex ss))))
                 (vla-put-elevation Obj el)
                 (vla-put-ConstantWidth Obj cw)
                 (vla-put-layer Obj lay)
....

HOWEVER, if the source one has varying  width, there will be no ConstantWidth property!  It could test whether it's an available property before setting and applying it, if appropriate.

[Kent1Cooper]

---

@Kent1Cooper wrote:

---

....

HOWEVER, if the source one has varying  width, there will be no ConstantWidth property!  It could test whether it's an available property before setting and applying it, if appropriate.

---

A little more complicated -- in an earlier version, that property just doesn't appear at all for a varying-width Polyline, but in 2019, I find the property is "available," but invalid.  But something like this should work, with cw also added to the localized-variables list at the top:

(defun c:pmtch  (/ ent cObj lay col lt lts lw el cw ss)
....
            lw  (vla-get-lineweight cObj)
            el  (vla-get-Elevation cObj))
      (if ; does it have a valid global width?
        (not
          (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-get-ConstantWidth (list obj))
          ); ...error-p
        ); not
        (setq cw (vla-get-ConstantWidth obj)); then -- get its global width...
      ); if
      (if (setq ss (ssget (list (cons 0 "*POLYLINE")
                                (if (getvar "CTAB")
....
                                       (mapcar 'cadr (ssnamex ss))))
                 (vla-put-elevation Obj el)
                 (if cw (vla-put-ConstantWidth Obj cw)); ...and assign it
                 (vla-put-layer Obj lay)
....

[That "putting" line can be anywhere in the sequence of "putting" operations.]