434939575 发表于 2014-4-7 09:36:26

图元原地复制变色到。原图层名加后缀

(defun c:tt ()      ; 图元原地复制变色到。原图层名加后缀

(VL-LOAD-COM)
(setq ss (car (entsel "\n 只能单选图元")))

(setq ss-en (entget ss))

(setqAcadObject   (vlax-get-acad-object)

AcadDocument (vla-get-ActiveDocument AcadObject)

mSpace       (vla-get-ModelSpace AcadDocument)
)

(setq LayerSel (vla-get-Layers AcadDocument))



(setqtestLayer (vla-add LayerSel

         (STRCAT
         (cdr (assoc 8 ss-en)

         )
         "--复制"

         )
      )
)
(setq mm (vla-get-Name testLayer))

(command "copy" ss "" '(0 0) "")
(command "chprop"
   (entlast)
   ""
   "la"
   (vla-get-Name testLayer)
   "C"
   "6"
   ""
)


(princ)

)

页: [1]
查看完整版本: 图元原地复制变色到。原图层名加后缀