圆坐标统计工具，，，，字母编码不能递增
本帖最后由 皇上快溜 于 2016-10-14 00:23 编辑字母编码不能结合孔大小特征递增，如图，编码全是A123，，不能递增到 B 和 c ，，，，
(setq P2 (getpoint "\n基准点:"))
(setq P3 '(0 0))
(if (= P2 NIL)
(setq P2 P3)
)
(setq X_P2 (car P2))
(setq Y_P2 (nth 1 P2))
(setq txt "ABCDEFGHJKLMNPQRSTUVWXYZ");;;;;;;;字母
(setq SS (ssget '((0 . "CIRCLE"))))
(setq COUNT 0
N 0
)
(setq i 1);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;字母循环起点
(setq stxt (substr txt i 1));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;字母循环起点
(setq R_LIST NIL)
(setq X_LIST NIL)
(setq Y_LIST NIL)
(repeat (sslength SS)
(setq EN (ssname SS N))
(setq ED (entget EN))
(if (not (member
(setq CEN (cdr (assoc 10 ED)))
CEN_LIST
)
)
(progn
(setq CEN_LIST (append CEN_LIST (list CEN)))
(setq CEN_X (list (car CEN)))
(setq CEN_Y (list (cadr CEN)))
(setq TMP (cdr (assoc 40 ED)))
(setq R_LIST (cons (list TMP COUNT) R_LIST))
(setq X_LIST (cons CEN_X X_LIST))
(setq Y_LIST (cons CEN_Y Y_LIST))
;(setq jjtxt (strcat stxt R_LIST));;;;;;在这里想将 stxt 结合 R_LIST 值的变化定义成字母可递增的函数 jjtxt 失败了
(setq COUNT (1+ COUNT));;;;;;;;;数字
(setq NOU (itoa COUNT));;;;;;;;;;;;;;数字循环
(setq xtxt (strcat stxt NOU));;;;;;;;;;;;;;;;;字母 + 数字
(command "_.text" "j" "C" CEN T_HIGH "" xtxt);;;;;;;;;;;;;;;字母 + 数字（文本标注）
)
)
(setq i (+ i 1));;;;;;;;字母递增
(setq N (1+ N));;;;;;;;;;;;;;;;;选圆循环
)
前后摆弄了两个功能类似的程序，都不如意。想请各位高人帮忙改改，谢谢个位。
本帖最后由 皇上快溜 于 2016-10-14 00:24 编辑
全码
(defun AI_ERROR (ERRMSG)
(if ERRMSG
'("console break"
"Function Cancelled"
)
(princ (strcat "\nError: " ERRMSG))
)
(princ)
) ;_defun
;;;_______________________________________________________
(defun WRITE_LIST (R_LIST /)
(command "_.text" "j" "C" P1 T_HIGH 0 "序号")
(command "_.text"
"j"
"C"
(polar P1 0 (* T_HIGH 7))
T_HIGH
0
"孔径"
)
(command "_.text"
"j"
"C"
(polar P1 0 (* T_HIGH 16))
T_HIGH
0
"X 坐标"
)
(command "_.text"
"j"
"C"
(polar P1 0 (* T_HIGH 26))
T_HIGH
0
"Y 坐标"
)
(setq P1 (polar P1 (/ pi -2.0) (* T_HIGH 2)))
(setq N 1)
(while (/= (setq DATA (car R_LIST)) NIL)
(setq DATA1 (car X_LIST))
(setq DATA2 (car Y_LIST))
(command "_.text"
"j"
"c"
(polar P1 0 (* T_HIGH 7))
T_HIGH
""
(strcat "%%C" (rtos (* (car DATA) 2.0) 2 2))
)
(command "_.text"
"j"
"c"
(polar P1 0 (* T_HIGH 16))
T_HIGH
""
(rtos (- (car DATA1) X_P2))
)
(command "_.text"
"j"
"c"
(polar P1 0 (* T_HIGH 25))
T_HIGH
""
(rtos (- (car DATA2) Y_P2))
)
(command "_.text"
"j"
"C"
(polar P1 0 (* T_HIGH 0.25))
T_HIGH
""
(rtos N)
)
(setq P1 (polar P1 (/ pi -2.0) (* T_HIGH 2)))
(setq R_LIST (cdr R_LIST))
(setq X_LIST (cdr X_LIST))
(setq Y_LIST (cdr Y_LIST))
(setq N (1+ N))
)
)
;;;_______________________________________________________
(defun WRITE_LINE (/ LL)
(setq P1 (polar P1 (/ pi 2.0) (* T_HIGH 1.5)))
(command "_.LINE"
(polar P1 pi (* T_HIGH 2.5))
(polar P1 0 (* T_HIGH 30))
""
)
(command "_.CHANGE" (entlast) "" "P" "Color" "2" "")
(command "_.ARRAY"
(entlast)
""
"R"
(+ (length R_LIST) 2)
""
(* 2 T_HIGH)
)
(command "_.LINE"
(polar P1 pi (* T_HIGH 2.5))
(cdr (assoc 10 (entget (entlast))))
""
)
(command "_.CHANGE" (entlast) "" "P" "Color" "2" "")
(setq LL (entlast))
(command "_.COPY" LL "" P1 (polar P1 0 (* T_HIGH 5.0)))
(command "_.COPY" LL "" P1 (polar P1 0 (* T_HIGH 13.5)))
(command "_.COPY" LL "" P1 (polar P1 0 (* T_HIGH 23)))
(command "_.COPY" LL "" P1 (polar P1 0 (* T_HIGH 32.5)))
)
;;;_______________________________________________________
(defun C:LBB (/ T_HIG T_HIGHSS COUNT R_LISTX_LIST
Y_LISTEN ED CEN CEN_X CEN_Y TMP
NOU P1 CEN_LIST N
)
(setvar "MODEMACRO" "***SPRING***")
(setq CM (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq OLD_ERROR *ERROR*
*ERROR* AI_ERROR
)
(command "_.UNDO" "group")
(command "_.UCS" "World")
(princ "\n字高:")
(setq T_HIG (getvar "TEXTSIZE"))
(princ T_HIG)
(setq T_HIGH (getstring ">"))
(if (= T_HIGH "")
(setq T_HIGH T_HIG)
(setq T_HIGH (atof T_HIGH))
)
(setq P2 (getpoint "\n基准点:"))
(setq P3 '(0 0))
(if (= P2 NIL)
(setq P2 P3)
)
(setq X_P2 (car P2))
(setq Y_P2 (nth 1 P2))
(setq txt "ABCDEFGHJKLMNPQRSTUVWXYZ");;;;;;;;字母
(setq SS (ssget '((0 . "CIRCLE"))))
(setq COUNT 0
N 0
)
(setq i 1);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;字母循环起点
(setq stxt (substr txt i 1)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;字母循环起点
(setq R_LIST NIL)
(setq X_LIST NIL)
(setq Y_LIST NIL)
(repeat (sslength SS)
(setq EN (ssname SS N))
(setq ED (entget EN))
(if (not (member
(setq CEN (cdr (assoc 10 ED)))
CEN_LIST
)
)
(progn
(setq CEN_LIST (append CEN_LIST (list CEN)))
(setq CEN_X (list (car CEN)))
(setq CEN_Y (list (cadr CEN)))
(setq TMP (cdr (assoc 40 ED)))
(setq R_LIST (cons (list TMP COUNT) R_LIST))
(setq X_LIST (cons CEN_X X_LIST))
(setq Y_LIST (cons CEN_Y Y_LIST))
;(setq jjtxt (strcat stxt R_LIST));;;;;;;;;;;;;;;;;这里
(setq COUNT (1+ COUNT));;;;;;;;;数字
(setq NOU (itoa COUNT));;;;;;;;;;;;;;数字循环
(setq xtxt (strcat stxt NOU));;;;;;;;;;;;;;;;;字母 + 数字
(command "_.text" "j" "C" CEN T_HIGH "" xtxt);;;;;;;;;;;;;;;字母 + 数字（文本标注）
)
)
(setq i (+ i 1));;;;;;;;字母递增
(setq N (1+ N));;;;;;;;;;;;;;;;;选圆循环
)
(setq X_LIST (reverse X_LIST))
(setq Y_LIST (reverse Y_LIST))
(setq P1 (getpoint "\ninsert point"))
(setq R_LIST (vl-sort R_LIST
(function (lambda (E1 E2)
(< (cadr E1) (cadr E2))
)
)
)
)
(WRITE_LIST R_LIST)
(WRITE_LINE)
(command "_.UCS" "Prev")
(command "_.UNDO" "end")
(setvar "cmdecho" CM)
(setq *ERROR* OLD_ERROR)
(princ)
)
页:
[1]