;;; zco_rotate.lsp --- 复制+旋转/镜像  by Cfer  2026.7.29  明经通道
;;; 加载后命令: ZCO
;;; 选对象 - 选基点 -  按键AD顺逆旋转/按键WS上下左右镜像 - 右键/空格/回车结束
;;; 旋转/对称中心 = 鼠标当前位置
(if (not *zco-ang*) (setq *zco-ang* 90.0))

(defun zco-loadcfg ()
  (if (not (member *zco-ang* '(15.0 30.0 45.0 60.0 90.0)))
    (setq *zco-ang* 90.0))
  (if (getenv "ZCO_Angle")
    (setq *zco-ang* (atof (getenv "ZCO_Angle"))))
  (if (not (member *zco-ang* '(15.0 30.0 45.0 60.0 90.0)))
    (setq *zco-ang* 90.0)))

(defun zco-savecfg ()
  (setenv "ZCO_Angle" (rtos *zco-ang* 2 0)))

(defun zco-try (fn args / r)
  (setq r (vl-catch-all-apply fn args))
  (if (vl-catch-all-error-p r) nil r))

(defun zco-doc (/ acad)
  (if (setq acad (zco-try 'vlax-get-acad-object nil))
    (zco-try 'vla-get-activedocument (list acad))))

(defun zco-e2o (en)
  (if (and en (entget en)) (zco-try 'vlax-ename->vla-object (list en))))

(defun zco-ss? (ss) (and ss (> (sslength ss) 0)))

;; 深拷贝 接受选择集或对象列表
(defun zco-copy (src / i o out)
  (setq out nil)
  (cond
    ((= (type src) 'PICKSET)
     (setq i 0)
     (repeat (sslength src)
       (if (setq o (zco-try 'vla-copy (list (zco-e2o (ssname src i)))))
         (setq out (cons o out)))
       (setq i (1+ i))))
    ((listp src)
     (foreach x src
       (if (setq o (zco-try 'vla-copy (list x)))
         (setq out (cons o out))))))
  (reverse out))

(defun zco-del (objs)
  (foreach o objs (zco-try 'vla-delete (list o))))

(defun zco-move (objs delta / origin target)
  (setq origin (vlax-3d-point '(0.0 0.0 0.0))
        target (vlax-3d-point delta))
  (foreach o objs (vl-catch-all-apply 'vla-move (list o origin target))))

(defun zco-rot (objs base rotang / pt)
  (setq pt (vlax-3d-point base))
  (foreach o objs (vl-catch-all-apply 'vla-rotate (list o pt rotang))))

;; 镜像 删原件留镜像
(defun zco-mir (objs base mode / x y z p1 p2 pt1 pt2 new out)
  (setq x (car base) y (cadr base)
        z (if (caddr base) (caddr base) 0.0))
  (if (= mode "ud")
    (setq p1 (list (- x 1.0) y z) p2 (list (+ x 1.0) y z))
    (setq p1 (list x (- y 1.0) z) p2 (list x (+ y 1.0) z)))
  (setq pt1 (vlax-3d-point p1) pt2 (vlax-3d-point p2) out nil)
  (foreach o objs
    (if (setq new (zco-try 'vla-mirror (list o pt1 pt2)))
      (progn (setq out (cons new out)) (zco-try 'vla-delete (list o)))
      (setq out (cons o out))))
  (reverse out))

;; DCL
(defun zco-dcl-strs ()
  '("zco_cfg : dialog {"
    "  label = \"ZCO 旋转设置\";"
    "  : boxed_radio_column {"
    "    label = \"预设旋转角度\";"
    "    : radio_button { key = \"a15\"; label = \"15度\"; }"
    "    : radio_button { key = \"a30\"; label = \"30度\"; }"
    "    : radio_button { key = \"a45\"; label = \"45度\"; }"
    "    : radio_button { key = \"a60\"; label = \"60度\"; }"
    "    : radio_button { key = \"a90\"; label = \"90度\"; }"
    "  }"
    "  : row {"
    "    fixed_width = true; alignment = centered;"
    "    : button { key = \"accept\"; label = \"确定\"; is_default = true; }"
    "    : button { key = \"cancel\"; label = \"取消\"; is_cancel = true; }"
    "  }"
    "}"))

(defun zco-dcl-write (/ fn f)
  (setq fn (vl-filename-mktemp "zco_cfg.dcl"))
  (if (setq f (open fn "w"))
    (progn (foreach x (zco-dcl-strs) (write-line x f)) (close f) fn)))

(defun zco-dcl-rm (fn)
  (if (and fn (findfile fn)) (zco-try 'vl-file-delete (list fn))))

;; 命令行设置 (DCL 回退)
(defun zco-cfg-cli (/ a)
  (princ (strcat "\n预设旋转角度 15/30/45/60/90 <" (rtos *zco-ang* 2 0) ">: "))
  (setq a (getint))
  (if (and a (member (float a) '(15.0 30.0 45.0 60.0 90.0)))
    (setq *zco-ang* (float a)))
  (zco-savecfg) t)

(defun zco-cfg-dlg (/ dcl id ok ang)
  (setq ang (rtos *zco-ang* 2 0) dcl (zco-dcl-write))
  (if (not dcl)
    (zco-cfg-cli)
    (progn
      (setq id (zco-try 'load_dialog (list dcl)))
      (if (and id (> id 0) (zco-try 'new_dialog (list "zco_cfg" id)))
        (progn
          (zco-try 'set_tile (list (strcat "a" ang) "1"))
          (foreach n '("15" "30" "45" "60" "90")
            (zco-try 'action_tile (list (strcat "a" n)
                  (strcat "(setq ang \"" n "\")"))))
          (zco-try 'action_tile (list "accept" "(setq ok T)(done_dialog 1)"))
          (zco-try 'action_tile (list "cancel" "(setq ok nil)(done_dialog 0)"))
          (zco-try 'start_dialog nil)
          (zco-try 'unload_dialog (list id))
          (zco-dcl-rm dcl)
          (if ok (progn (setq *zco-ang* (atof ang)) (zco-savecfg) t)))
        (progn
          (if (and id (> id 0)) (zco-try 'unload_dialog (list id)))
          (zco-dcl-rm dcl) (zco-cfg-cli))))))

(defun zco-key->act (key)
  (cond
    ((member key '(13 32 27)) 'done)
    ((member key '(67 99))    'cfg)
    ((member key '(65 97 37 43 61)) 'rotl)
    ((member key '(68 100 39 45 95)) 'rotr)
    ((member key '(87 119))   'mud)
    ((member key '(83 115))   'mlr)))

(defun zco-pmt ()
  (princ
    (strcat
      "\nZCO 复制+旋转/镜像 | 角度: " (rtos *zco-ang* 2 0) "度"
      "\nA/左/+ 逆时针  D/右/- 顺时针  W 上下镜像  S 左右镜像  C 设置"
      "\n左键=定稿复制 右键/空格/回车/Esc=结束")))

(defun zco-getss (/ ss)
  (setq ss (zco-try 'ssget '("_I")))
  (if (zco-ss? ss) ss
    (progn (princ "\n选择要复制的对象: ") (zco-try 'ssget nil))))

(defun zco-run (/ *error* doc ss base objs prev done undo ev act rotang delta cur)
  (vl-load-com)
  (zco-loadcfg)
  (setq ss (zco-getss))
  (if (not (zco-ss? ss))
    (progn (princ "\n未选择对象，退出。") (princ) (exit)))
  (setq base (getpoint "\n指定基点: "))
  (if (not base)
    (progn (princ "\n未指定基点，退出。") (princ) (exit)))
  (setq doc (zco-doc) objs nil prev base done nil undo nil
        rotang (* pi (/ *zco-ang* 180.0)))
  (defun *error* (msg)
    (if objs (zco-del objs))
    (if undo (progn (vl-catch-all-apply 'vla-endundomark (list doc)) (setq undo nil)))
    (if (and msg (not (member msg '("Function cancelled" "quit / exit abort" "console break"))))
      (princ (strcat "\nZCO 错误: " msg)))
    (princ))
  (if doc (setq undo (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-startundomark (list doc))))))
  (setq objs (zco-copy ss))
  (if (not objs)
    (progn
      (if undo (progn (vl-catch-all-apply 'vla-endundomark (list doc)) (setq undo nil)))
      (princ "\n复制对象失败，退出。") (princ) (exit)))
  (zco-pmt)
  (while (not done)
    (setq ev (grread t 7 0))
    (if (not ev) (setq ev '(2 0)))
    (cond
      ((= (car ev) 5) ; 鼠标移动
       (setq cur (cadr ev))
       (if (not (equal cur prev 1e-8))
         (progn
           (setq delta (list (- (car cur) (car prev))
                             (- (cadr cur) (cadr prev)) 0.0))
           (zco-move objs delta)))
       (setq prev cur))
      ((= (car ev) 2) ; 按键
       (setq act (zco-key->act (cadr ev)))
       (cond
         ((eq act 'done)
          (if objs (zco-del objs)) (setq done t))
         ((eq act 'cfg)
          (zco-cfg-dlg) (setq rotang (* pi (/ *zco-ang* 180.0))) (zco-pmt))
         ((eq act 'rotl) (zco-rot objs prev rotang))
         ((eq act 'rotr) (zco-rot objs prev (- rotang)))
         ((eq act 'mud)  (setq objs (zco-mir objs prev "ud")))
         ((eq act 'mlr)  (setq objs (zco-mir objs prev "lr")))))
      ((= (car ev) 3) ; 左键 定稿并生成新副本继续
       (setq objs (zco-copy objs))
       (if (not objs)
         (progn (princ "\n复制对象失败，退出。") (setq done t))))
      ((member (car ev) '(11 25)) ; 右键 / Ctrl+C
       (if objs (progn (zco-del objs) (setq objs nil)))
       (setq done t))))
  (if objs (zco-del objs))
  (if undo (progn (vl-catch-all-apply 'vla-endundomark (list doc)) (setq undo nil)))
  (zco-savecfg)
  (princ))

(defun C:ZCO () (zco-run))
(princ "\nZCO 复制+旋转/镜像已加载。命令：ZCO")
(princ)