怎么把输入图层名改为用鼠标点选 ?

9701519

(defun c:mlay ()
  (setq lay1 (getstring "\n请输入要合并的图层:")
lay2 (getstring "\n请输入要保留的图层:")
  )
  (MergeLayers lay1 lay2)
)
;; Usage: (MergeLayers "Layer1" "Layer2")
(defun MergeLayers (lay1 lay2 / i block countOfBlock1)
  (command "-layer" "u" lay1 "")
  (setq block (vla-get-blocks
  (vla-get-activedocument (vlax-get-acad-object))
       )
  )
  (setq i 0
countOfBlock1
  (vla-get-count block)
  )
  (while (< i countOfBlock1)
    (changeLayer block)
    (setq i (1+ i)
    )
  )
  (if (= (getvar "CLAYER") lay1)
    (setvar "CLAYER" lay2)
  )
  (command "_.purge" "lay" lay1 "_n")
  (princ)
)
(defun changeLayer (blocks / cnt space countOfBlock2)
;;;  (setq cnt 0
;;; countOfBlock2
;;;  (vla-get-count blocks);;;某些时候这句代码会出错，说vla-get-count不能用于blocks对象，不知为何？
;;;  )
;;;
;;;  (setq errobj (vl-catch-all-apply (vla-get-count blocks)))
;;;  (if (vl-catch-all-error-p errobj)
;;;    (setq cnt (1+ cnt))
;;;    (exit)
;;;  )
  (setq cnt 0
countOfBlock2
  (vla-get-count blocks)
  )
  (while (< cnt countOfBlock2)
    (setq space (vla-item blocks cnt))
    (vlax-for itm space
      (if (= (strcase (vla-get-layer itm)) (strcase lay1))
(vla-put-layer itm lay2)
      )
;;;如果是块，递归下去
      (if (and (= (vla-get-ObjectName itm) "AcDbBlockReference")
        (= (vla-get-HasAttributes itm) :vlax-true)
   )
(changeLayer itm)
      )
    )
    (setq cnt (1+ cnt))
  )
)



怎么把输入图层名改为用鼠标点选 ?


该贴已经同步到 9701519的微博