(CTB)压力管道安装焊接检验记录卡页码和管线号编号工具

(defun C:CTB(/ *error* edata ent issel key lst mstr num opfile path pg pgn)
    (defun *error*(msg)
        (if opfile (close opfile))
        (prin1)
    )
    (setq path (strcat (Vla-Get-Path (Vlax-Get-Acad-Object)) "\\support\\MyCTB.txt"))
    (if (findfile path)
        (progn
            (setq opfile (open path "r") lst (read (read-line opfile)) pg (nth 0 lst) pgn (nth 1 lst) num (nth 2 lst) key (nth 3 lst) mstr (nth 4 lst) issel (nth 5 lst))
            (close opfile)
        )
        (setq pg 1 pgn 1 num 1 key nil mstr (strcat "页码自增：" (rtos pg)) issel nil)
    )
    (initget "M m G g S s C c")
    (while (setq ent (entsel (strcat "\n选择对象[页码自增或分页(M)/管线号自增(G)/管线号同号(S)/重置页码和管线号(C)]当前【" mstr "】>：")))
        (if (= (type ent) 'str)
            (progn
                (setq ent (strcat ent))
                (cond
                    ((= ent "M")
                        (if key
                            (setq key nil pg (if issel (1+ pg) pg) mstr (strcat "页码自增：" (rtos pg)))
                            (setq key "M" pg (if issel (1- pg) pg) mstr (strcat "页码分页：" (rtos pg) "-" (rtos pgn)))
                        )
                    )
                    ((= ent "G") (setq key "G" mstr (strcat "管线号自增：" (rtos num))))
                    ((= ent "S") (setq key "S" mstr (strcat "管线号同号：" (rtos num))))
                    ((= ent "C") 
                        (setq pg 1 pgn 1 num 1 key nil mstr (strcat "页码自增：" (rtos pg)) issel nil)
                        (write-line (vl-prin1-to-string (list pg pgn num key mstr issel)) (setq opfile (open path "w")))
                        (close opfile)
                    )
                )
            )
            (progn
                (setq edata (entget (car ent)))
                (cond
                    ((= key nil)
                        (setq pgn 1 issel nil)
                        (entmod (subst (cons 1 (strcat "{\\W0.8;" (rtos pg) "}")) (assoc 1 edata) edata))
                        (setq pg (1+ pg) mstr (strcat "页码自增：" (rtos pg)) )
                    )
                    ((= key "M")
                        (setq issel T)
                        (entmod (subst (cons 1 (strcat "{\\W0.8;" (rtos pg) "-" (rtos pgn) "}")) (assoc 1 edata) edata))
                        (setq pgn (1+ pgn) mstr (strcat "页码分页：" (rtos pg) "-" (rtos pgn)))
                    )
                    ((= key "G")
                        (entmod (subst (cons 1 (strcat "{\\fSimSun|b1|i1|c134|p2;" (rtos num) "}")) (assoc 1 edata) edata))
                        (setq num (1+ num) mstr (strcat "管线号自增：" (rtos num)))
                    )
                    ((= key "S")
                        (entmod (subst (cons 1 (strcat "{\\fSimSun|b1|i1|c134|p2;" (rtos num) "}")) (assoc 1 edata) edata))
                        (setq mstr (strcat "管线号同号：" (rtos num)))
                    )
                )
            )
        )
        (write-line (vl-prin1-to-string (list pg pgn num key mstr issel)) (setq opfile (open path "w")))
        (close opfile)
        (initget "M m G g S s C c")
    )
    (*error* nil)
    (prin1)
)