[分享]快速複製物件(LISP)

代碼:

　;　[AutoCAD EXTEND] QUICK COPY(BY LAYER COPY OBJECT).
　;　[AutoCAD "指令"功能延伸] 快速複製(依圖層複製物件)。
　;　支援軟體版本("AutoCAD")
　;　設計者：Devin,Chou
　;　版權所有，歡迎使用
　;　Rev.2(2016/06/06)
　;　進版說明： 1.新增-複製模式[單一圖層(S)/多圖層(M)]
(defun C:qco (/ L_X ss
                lc_s L_s
                lc_m m_lt m_in m_o L_mt L_m )
(setvar "cmdecho" 0 )
(initget "S M" )
(setq L_X
    (getkword
    (strcat "\n複製模式[單一圖層(S)/多圖層(M)]<S>:" )))
(if (= L_X nil )
    (setq L_X "S" )) ; if.end
(if (= L_X "S" )
    (setq lc_s 0 )) ; if.end
(if (= L_X "M" )
    (setq lc_m 0 )) ; if.end
(while (= lc_s 0 )
(setq L_s
    (assoc 8
    (entget
    (car
    (entsel "\n請選取要複製物件的圖層:" )))))
(princ "\n圖層:" )(princ (cdr L_s ))
(setq lc_s 1 )) ; while-lc_s.end
(while (= lc_m 0 )
(setq m_lt '() m_in 0 )
(princ "\n請選取要複製物件的圖層(多圖層):" )
(setq m_o (ssget ))
(repeat (sslength m_o )
(setq L_mt
    (assoc 8
    (entget
    (ssname m_o m_in ))))
(princ "\n圖層:" )(princ (cdr L_mt ))
(setq m_lt (cons L_mt m_lt ))
(setq m_in
    (1+ m_in ))) ; repeat.end
(setq L_m
    (cons '(-4 . "<OR")
    (reverse
    (cons '(-4 . "OR>") m_lt ))))
(setq lc_m 1 )) ; while-lc_m.end
(princ "\n請選取要複製的物件:" )
(if (= L_X "S" )
(setq ss (ssget (list L_s )))) ; if.end
(if (= L_X "M" )
(setq ss (ssget L_m ))) ; if.end
(command "COPY" ss "" )
(prin1)
) ; end
(princ "\nC:qco(2版)")
(prin1)

devinchou 寫到:這個小程式,
是依所選的圖層,
來複製物件。
目前手邊有寫移動、複製、刪除,
都是依圖層,
下次進版時,
會將物件型式及顏色也進去的。