[求助]：eachy斑竹请进

txzjtxzj

eachy斑竹请进，这是一个双行数字序号的程序
能不能加个功能，就是插入这2行文字的时候可以选择旋转
(vl-load-com)
(setq *ACADDOC* (vla-get-activedocument (vlax-get-acad-object)))
(defun SL-NUM2CHAR (INT / STR RES CHAR MBR)
(while (/= (/ INT 26) 0)
(setq RES (rem INT 26)
INT (/ INT 26))
(if (= RES 0)
(setq RES 26
INT (1- INT)))
(setq CHAR (cons RES CHAR)))
(if (/= INT 0)
(setq CHAR (reverse (cons INT CHAR))))
(setq STR NIL)
(foreach MBR CHAR (setq STR (cons (+ MBR 64) STR)))
(setq STR (vl-list->string STR)))
(defun SL-CHAR2NUM (STR / I INT)
(setq I 0
STR (reverse (vl-string->list (strcase STR)))
INT 0)
(while (nth I STR)
(setq INT (+ INT (* (- (nth I STR) 64) (expt 26 I)))
I (1+ I)))
(abs INT))
(defun TNJ-DCL-ON2 (/ ON)
(setq *TNJ-ON2 (get_tile "DCL_ON2")
ON (- 1 (atoi *TNJ-ON2)))
(mode_tile "DCL_PF2" ON)
(mode_tile "DCL_SN2" ON)
(mode_tile "DCL_AN2" ON)
(mode_tile "DCL_SF2" ON)
(mode_tile "DCL_LM2" ON)
(mode_tile "DCL_ON3" ON)
(TNJ-DCL-ON3)
(if (= ON 1)
(progn (mode_tile "DCL_PF3" 1)
(mode_tile "DCL_SN3" 1)
(mode_tile "DCL_AN3" 1)
(mode_tile "DCL_SF3" 1)
(mode_tile "DCL_LM3" 1)))
(TNJ-DCL-UP))
(defun TNJ-DCL-ON3 (/ ON)
(setq *TNJ-ON3 (get_tile "DCL_ON3")
ON (- 1 (atoi *TNJ-ON3)))
(mode_tile "DCL_PF3" ON)
(mode_tile "DCL_SN3" ON)
(mode_tile "DCL_AN3" ON)
(mode_tile "DCL_SF3" ON)
(mode_tile "DCL_LM3" ON)
(TNJ-DCL-UP))
(defun TNJ-DCL-UP (/ TEXT1 TEXT2)
(TNJ-GETDATA)
(if (= *TNJ-LM1 "1")
(setq TEXT1 (SL-NUM2CHAR *TNJ-NUM1))
(setq TEXT1 (itoa *TNJ-NUM1)))
(setq TEXT1 (strcat *TNJ-PRE1 TEXT1 *TNJ-SUF1))
(if (= *TNJ-ON2 "1")
(if (= *TNJ-LM2 "1")
(setq TEXT2 (strcat *TNJ-PRE2 (SL-NUM2CHAR *TNJ-NUM2) *TNJ-SUF2))
(setq TEXT2 (strcat *TNJ-PRE2 (itoa *TNJ-NUM2) *TNJ-SUF2))))
(if (= *TNJ-ON2 *TNJ-ON3 "1")
(if (= *TNJ-LM3 "1")
(setq TEXT2 (strcat TEXT2 *TNJ-PRE3 (SL-NUM2CHAR *TNJ-NUM3) *TNJ-SUF3))
(setq TEXT2 (strcat TEXT2 *TNJ-PRE3 (itoa *TNJ-NUM3) *TNJ-SUF3))))
(setq text1 (strcat "格式预览 第一行: " TEXT1))
(IF (= (type TEXT2) 'STR)(SETQ TEXT1 (STRCAT TEXT1 " 第二行: " TEXT2)))
(set_tile "DCL_PREVIEW" TEXT1))
(defun TNJ-DATANUM ()
(if (/= (type *TNJ-NUM1) 'INT)
(setq *TNJ-NUM1 1))
(if (/= (type *TNJ-NUM1+) 'INT)
(setq *TNJ-NUM1+ 1))
(if (/= (type *TNJ-NUM2) 'INT)
(setq *TNJ-NUM2 1))
(if (/= (type *TNJ-NUM2+) 'INT)
(setq *TNJ-NUM2+ 1))
(if (/= (type *TNJ-NUM3) 'INT)
(setq *TNJ-NUM3 1))
(if (/= (type *TNJ-NUM3+) 'INT)
(setq *TNJ-NUM3+ 1))
(if (/= (type *TNJ-PRE1) 'STR)
(setq *TNJ-PRE1 ""))
(if (/= (type *TNJ-PRE2) 'STR)
(setq *TNJ-PRE2 ""))
(if (/= (type *TNJ-PRE3) 'STR)
(setq *TNJ-PRE3 ""))
(if (/= (type *TNJ-SUF1) 'STR)
(setq *TNJ-SUF1 ""))
(if (/= (type *TNJ-SUF2) 'STR)
(setq *TNJ-SUF2 ""))
(if (/= (type *TNJ-SUF3) 'STR)
(setq *TNJ-SUF3 ""))
(if (/= (type *TNJ-TH) 'REAL)
(setq *TNJ-TH 5)))
(defun C:TNJ ()
(setvar "CMDECHO" 0)
(prompt "自动文字编号\n")
(command ".UNDO" "BE")
(setq *TNJ-DCL-ID
(load_dialog "TextNumJ.DCL")
*MARK-LIST NIL)
(TNJ-DATANUM)
(TNJ-DIALOG)
(princ))
(defun TNJ-DIALOG (/ DCL_ACT)
(new_dialog "TNJDCL" *TNJ-DCL-ID)
(if (= *TNJ-LM1 "1")
(progn (set_tile "DCL_LM1" "1") (set_tile "DCL_SN1" (SL-NUM2CHAR *TNJ-NUM1)))
(progn (set_tile "DCL_LM1" "0") (set_tile "DCL_SN1" (itoa *TNJ-NUM1))))
(set_tile "DCL_AN1" (itoa *TNJ-NUM1+))
(if (= *TNJ-ON2 "1")
(progn (set_tile "DCL_ON2" "1")
(mode_tile "DCL_PF2" 0)
(mode_tile "DCL_SN2" 0)
(mode_tile "DCL_AN2" 0)
(mode_tile "DCL_SF2" 0)
(mode_tile "DCL_LM2" 0)(mode_tile "DCL_ON3" 0))
(progn (set_tile "DCL_ON2" "0")
(mode_tile "DCL_PF2" 1)
(mode_tile "DCL_SN2" 1)
(mode_tile "DCL_AN2" 1)
(mode_tile "DCL_SF2" 1)
(mode_tile "DCL_LM2" 1)(mode_tile "DCL_ON3" 1)))
(if (= *TNJ-LM2 "1")
(progn (set_tile "DCL_LM2" "1") (set_tile "DCL_SN2" (SL-NUM2CHAR *TNJ-NUM2)))
(progn (set_tile "DCL_LM2" "0") (set_tile "DCL_SN2" (itoa *TNJ-NUM2))))
(set_tile "DCL_AN1" (itoa *TNJ-NUM1+))
(if (= *TNJ-ON2 *TNJ-ON3 "1")
(progn (set_tile "DCL_ON3" "1")(mode_tile "DCL_PF3" 0)
(mode_tile "DCL_SN3" 0)
(mode_tile "DCL_AN3" 0)
(mode_tile "DCL_SF3" 0)
(mode_tile "DCL_LM3" 0))
(progn (set_tile "DCL_ON3" "0")(mode_tile "DCL_PF3" 1)
(mode_tile "DCL_SN3" 1)
(mode_tile "DCL_AN3" 1)
(mode_tile "DCL_SF3" 1)
(mode_tile "DCL_LM3" 1)))
(if (= *TNJ-LM3 "1")
(progn (set_tile "DCL_LM3" "1") (set_tile "DCL_SN3" (SL-NUM2CHAR *TNJ-NUM3)))
(progn (set_tile "DCL_LM3" "0") (set_tile "DCL_SN3" (itoa *TNJ-NUM3))))
(set_tile "DCL_AN1" (itoa *TNJ-NUM1+))
(set_tile "DCL_AN2" (itoa *TNJ-NUM2+))
(set_tile "DCL_AN3" (itoa *TNJ-NUM3+))
(set_tile "DCL_PF1" *TNJ-PRE1)
(set_tile "DCL_PF2" *TNJ-PRE2)(set_tile "DCL_PF3" *TNJ-PRE3)
(set_tile "DCL_SF1" *TNJ-SUF1)
(set_tile "DCL_SF2" *TNJ-SUF2)
(set_tile "DCL_SF3" *TNJ-SUF3)
(set_tile "DCL_TH" (rtos *TNJ-TH 2 2))
(TNJ-DCL-UP)
(action_tile "accept" "(TNJ-GETDATA)(done_dialog 1)")
(setq DCL_ACT (start_dialog))
(cond ((= DCL_ACT 1) (TNJ-DATANUM) (TNJ-MARK))))
(defun TNJ-GETDATA ()
(setq *TNJ-PRE1 (get_tile "DCL_PF1")
*TNJ-NUM1 (get_tile "DCL_SN1")
*TNJ-NUM1+ (atoi (get_tile "DCL_AN1"))
*TNJ-SUF1 (get_tile "DCL_SF1")
*TNJ-LM1 (get_tile "DCL_LM1")
*TNJ-ON2 (get_tile "DCL_ON2")
*TNJ-ON3 (get_tile "DCL_ON3")
*TNJ-TH (atof (get_tile "DCL_TH")))
(if (= *TNJ-ON2 "1")
(setq *TNJ-PRE2 (get_tile "DCL_PF2")
*TNJ-NUM2 (get_tile "DCL_SN2")
*TNJ-NUM2+ (atoi (get_tile "DCL_AN2"))
*TNJ-SUF2 (get_tile "DCL_SF2")
*TNJ-LM2 (get_tile "DCL_LM2")))
(if (= *TNJ-ON2 *TNJ-ON3 "1")
(setq *TNJ-PRE3 (get_tile "DCL_PF3")
*TNJ-NUM3 (get_tile "DCL_SN3")
*TNJ-NUM3+ (atoi (get_tile "DCL_AN3"))
*TNJ-SUF3 (get_tile "DCL_SF3")
*TNJ-LM3 (get_tile "DCL_LM3")))
(if (= (atoi *TNJ-NUM1) 0)
(setq *TNJ-NUM1 (SL-CHAR2NUM *TNJ-NUM1))
(setq *TNJ-NUM1 (atoi *TNJ-NUM1)))
(if (= *TNJ-ON2 "1")
(if (= (atoi *TNJ-NUM2) 0)
(setq *TNJ-NUM2 (SL-CHAR2NUM *TNJ-NUM2))
(setq *TNJ-NUM2 (atoi *TNJ-NUM2))))
(if (= *TNJ-ON2 *TNJ-ON3 "1")
(if (= (atoi *TNJ-NUM3) 0)
(setq *TNJ-NUM3 (SL-CHAR2NUM *TNJ-NUM3))
(setq *TNJ-NUM3 (atoi *TNJ-NUM3)))))
(defun TNJ-MARK (/ SPACE PT1 TEXT1 NEWTEXT1 PT2 TEXT2 NEWTEXT2)
(if (= "Model" (getvar "CTAB"))
(setq SPACE (vla-get-modelspace *ACADDOC*))
(setq SPACE (vla-get-paperspace *ACADDOC*)))
(while (setq PT1 (getpoint "指定编号位置: "))
(setq PT2 (trans (polar PT1 (* pi 1.5) (* 1.25 *TNJ-TH)) 1 0))
(setq PT1 (trans PT1 1 0))
(if (= *TNJ-LM1 "1")
(setq TEXT1 (SL-NUM2CHAR *TNJ-NUM1))
(setq TEXT1 (itoa *TNJ-NUM1)))
(setq TEXT1 (strcat *TNJ-PRE1 TEXT1 *TNJ-SUF1))
(if (= *TNJ-ON2 "1")
(if (= *TNJ-LM2 "1")
(setq TEXT2 (strcat *TNJ-PRE2 (SL-NUM2CHAR *TNJ-NUM2) *TNJ-SUF2))
(setq TEXT2 (strcat *TNJ-PRE2 (itoa *TNJ-NUM2) *TNJ-SUF2))))
(if (= *TNJ-ON2 *TNJ-ON3 "1")
(if (= *TNJ-LM3 "1")
(setq TEXT2 (strcat TEXT2 *TNJ-PRE3 (SL-NUM2CHAR *TNJ-NUM3) *TNJ-SUF3))
(setq TEXT2 (strcat TEXT2 *TNJ-PRE3 (itoa *TNJ-NUM3) *TNJ-SUF3))))
(setq NEWTEXT1 (vla-addtext SPACE TEXT1 (vlax-3d-point PT1) 1)
*MARK-LIST1 (append *MARK-LIST1 (list NEWTEXT1)))
(vla-put-height NEWTEXT1 *TNJ-TH)
(if (= *TNJ-ON2 "1")
(progn (setq NEWTEXT2 (vla-addtext SPACE TEXT2 (vlax-3d-point PT2) 1)
*MARK-LIST2 (append *MARK-LIST2 (list NEWTEXT2)))
(vla-put-height NEWTEXT2 *TNJ-TH)))
(setq *TNJ-NUM1 (+ *TNJ-NUM1 *TNJ-NUM1+))
(if (= *TNJ-ON2 "1")
(setq *TNJ-NUM2 (+ *TNJ-NUM2 *TNJ-NUM2+)))
(if (= *TNJ-ON2 *TNJ-ON3 "1")
(setq *TNJ-NUM3 (+ *TNJ-NUM3 *TNJ-NUM3+))))
(TNJ-OP))
(defun TNJ-OP (/ KEY END)
(initget "c s u q")
(setq KEY (getkword "\n输入选项 [继续(C)/设置(S)/取消末项(U)/退出(Q)]<退出>:"))
(cond ((= KEY "c") (TNJ-MARK))
((= KEY "s") (TNJ-DIALOG))
((= KEY "u")
(if (setq END (last *MARK-LIST1))
(progn (vla-delete END)
(setq *MARK-LIST1 (vl-remove END *MARK-LIST1)
*TNJ-NUM1 (- *TNJ-NUM1 *TNJ-NUM1+))
(if (= *TNJ-ON2 "1")
(setq *TNJ-NUM2 (- *TNJ-NUM2 *TNJ-NUM2+)))
(if (= *TNJ-ON2 *TNJ-ON3 "1")
(setq *TNJ-NUM3 (- *TNJ-NUM3 *TNJ-NUM3+))))
(alert "已经没有我写的了!别让我擦了!!"))
(if (and (= *TNJ-ON2 *TNJ-ON3 "1")(setq END (last *MARK-LIST2)))
(progn (vla-delete END) (setq *MARK-LIST2 (vl-remove END *MARK-LIST2))))
(TNJ-OP))
(t (unload_dialog *TNJ-DCL-ID) (command ".UNDO" "E"))))
(PRINC "双行文字编号---TNJ")(PRINC)







DCL

TNJDCL :dialog{label = "文字编号 ";
:row{
:boxed_column{label="第一行编号";
spacer_1;
:edit_box {key="DCL_PF1";label="前缀";action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_SN1";label="初值";action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_AN1";label="增量";action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_SF1";label="后缀";action="(TNJ-DCL-UP)";}
:toggle{key="DCL_LM1";label="字母编号";action="(TNJ-DCL-UP)";}
}
:boxed_column{label="第二行编号";
:toggle{key="DCL_ON2";label="启用";action="(TNJ-DCL-ON2)";}
:edit_box {key="DCL_PF2";label="前缀";is_enabled=false;action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_SN2";label="初值";is_enabled=false;action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_AN2";label="增量";is_enabled=false;action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_SF2";label="后缀";is_enabled=false;action="(TNJ-DCL-UP)";}
:toggle{key="DCL_LM2";label="字母编号";is_enabled=false;action="(TNJ-DCL-UP)";}
}
:boxed_column{label="第二行编号 2";
:toggle{key="DCL_ON3";label="启用";is_enabled=false;action="(TNJ-DCL-ON3)";}
:edit_box {key="DCL_PF3";label="前缀";is_enabled=false;action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_SN3";label="初值";is_enabled=false;action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_AN3";label="增量";is_enabled=false;action="(TNJ-DCL-UP)";}
:edit_box {key="DCL_SF3";label="后缀";is_enabled=false;action="(TNJ-DCL-UP)";}
:toggle{key="DCL_LM3";label="字母编号";is_enabled=false;action="(TNJ-DCL-UP)";}
}
}
:row{:edit_box {key="DCL_TH";label="字高";}
:text {key="DCL_PREVIEW";label="格式预览 ";width=48;}}
spacer_0;ok_cancel;
}