[编程交流] 设置选定对象层电流

(defun C:CADTUTUOR ( / )
(command "_LAYMCUR")
(princ)
)

(defun C:test ( / e )
 (if (setq e (car (entsel "\nSelect layer to become current: ")))
   (setvar 'clayer (cdr (assoc 8 (entget e))))
 )
 (princ)
)

; matches pick object for next command plus layer
(defun c:ZZZ (/ ent Obj lEnt)
 (vl-load-com)
 (while (setq ent (car (nentsel "\nSelect Object: ")))
   (setq Obj (vlax-ename->vla-object ent)
         typ (cdr (assoc 0 (entget ent))))
   (cond ((vl-position typ '("CIRCLE" "ARC" "ELLIPSE" "SPLINE" "XLINE"))
          (comInv typ nil) (PropMatch Obj (entlast)))
         ((eq "LWPOLYLINE" typ)
          (comInv "pline" nil) (PropMatch Obj (entlast)))
         ((eq "LINE" typ)
          (setq lEnt (entlast))
          (comInv typ nil)
          (foreach ent (EntCol (if lEnt lEnt (entlast)))
            (PropMatch Obj ent)))
         ((eq "HATCH" typ)
          (setq lEnt (entlast))
          (comInv typ t)
          (if (not (eq lEnt (entlast)))
            (PropMatch Obj (entlast))))
         ((eq "VIEWPORT" typ)
          (setq lEnt (entlast))
          (comInv "-vports" nil)
          (if (not (eq lEnt (entlast)))
            (PropMatch Obj (entlast))))))
 (princ))
(defun PropMatch (bObj dObj)
 (or (eq 'VLA-OBJECT (type bObj))
     (setq bObj (vlax-ename->vla-object bObj)))
 (or (eq 'VLA-OBJECT (type dObj))
     (setq dObj (vlax-ename->vla-object dObj)))
 (foreach prop '(Layer
                 Linetype
                 LinetypeScale
                 Color
                 Lineweight
                 ViewportOn
                 ShadePlot
                 DisplayLocked                  
                 GradientAngle
                 GradientCentered
                 GradientColor1
                 GradientColor2
                 GradientName
                 HatchObjectType
                 HatchStyle
                 ISOPenWidth
                 Origin
                 PatternAngle
                 PatternDouble
                 PatternScale
                 PatternSpace)
   (if (and (vlax-property-available-p bObj prop)
              (vlax-property-available-p dObj prop T))
     (vlax-put-property dObj prop
       (vlax-get-property bObj prop)))))
(defun EntCol (x / x)
 (if (setq x (entnext x))
   (cons x (EntCol x))))
(defun comInv (com flag)
 (if flag (initdia))
 (command (strcat "_." com))
 (while (eq 1 (logand 1 (getvar "CMDACTIVE")))
   (command pause)))