各位大侠帮小弟看下，这个程序生成的表格太小，能否放大100倍
本帖最后由 664571221 于 2019-10-23 14:15 编辑;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (list " 文字成表C18" "WZCB")
***********************************************************************************
(defun TEXT>ASCII (WORD LENGTH_WORD)
(setq List_ASCII (list))
(setq WORD (STRCATWORD " "))
(repeat LENGTH_WORD
(if (/= (SUBSTR WORD 2) "")
(PROGN
(setq List_ASCII (cons (ASCII WORD) List_ASCII))
(setq WORD (SUBSTR WORD 2))
)
(setq List_ASCII (cons '0 List_ASCII))
);end while
);end repeat
(setq List_ASCII List_ASCII)
);end defun
***********************************************************************************
(defun c:WZCB()
(setq odcmd (getvar "cmdecho")) ;;记录命令行回显方式
(setq odosm (getvar "osmode")) ;;记录当前捕捉方式
(setvar "cmdecho" 0) ;;设置命令行不回显
(command "undo" "be" )
(VL-LOAD-COM)
(princ "\n选择要统计的文字：")
(setq ss_text nil)
(while (= ss_text nil)
(setq ss_text (ssget '((0 . "TEXT,MTEXT"))) )
)
(setq n 0)
(setq list_text nil)
(repeat (sslength ss_text)
(setq ssn (ssname ss_text n))
(setq sst_temp (entget ssn))
;获取单行文字
(if (= (cdr (assoc 0 sst_temp)) "TEXT")
(setq ntext (cdr (assoc 1 sst_temp)))
)
;获取多行文字
(if (= (cdr (assoc 0 sst_temp)) "MTEXT")
(progn
(entmake sst_temp)
(setq ssn (ssname (ssget "L") 0))
(command "EXPLODE" ssn)
(setq text (ENTLAST))
(setq ntext (CDR (ASSOC 1 (entget text))))
(entdel text)
)
)
;增加到统计列表
(if (/= (setq num_text (cdr (assoc ntext list_text))) nil)
(SETQ list_text (SUBST (CONS ntext (1+ num_text)) (ASSOC ntext list_text) list_text))
(setq list_text (append list_text(list (cons ntext 1))) )
);end if
(setq n (1+ n))
);end repeat
(setq n 0 n_max 0)
(setq list_temp list_text)
;获取最大字长
(repeat (length list_temp)
(setq nn (strlen (car (nth n list_temp))) )
(if (> nn n_max) (setq n_max nn))
(setq n (1+ n))
);end repeat
;统计列表按文字内码排序
(setq list_text nil)
(repeat (length list_temp)
;查找list_temp里最大文字
(setq n 0)
(setq bt_text (car (nth 0 list_temp)))
(repeat (1- (length list_temp))
(setq text (car (nth (1+ n) list_temp)))
(SETQ bt_ASCII(TEXT>ASCII bt_text n_max))
(SETQ text_ASCII (TEXT>ASCII text n_max))
(SETQ 1big "yes" na (1- n_max) )
(if (< (nth na bt_ASCII) (nth na text_ASCII))
(SETQ 1big "no")
);end if
(while (and (= (nth na bt_ASCII) (nth na text_ASCII)) (> na 0) )
(setq na (1- na))
(if (< (nth na bt_ASCII) (nth na text_ASCII))
(SETQ 1big "no")
);end if
);end while
(if (= 1big "no") (setq bt_text text) )
(setq n (1+ n))
);end repeat
(setq btt_text (cons bt_text (CDR (ASSOC bt_text list_temp))) )
(setq list_text (append (list btt_text) list_text) )
(SETQ list_temp (SUBST (CONS "" "") (ASSOC bt_text list_temp) list_temp))
);end repeat
;输出成表格
(setq pt0 nil)
(WHILE (= pt0 nil) (setq pt0 (GETPOINT "\n指定表格位置:")) )
(setq ocolor (getvar "CECOLOR"))
(setvar "CECOLOR" "bylayer")
(setq olayer (getvar "clayer"))
;;设定文字样式
(if (and (findfile "ROS.SHX") (findfile "HZTXT.SHX"))
(progn
(command "-style" "JHZX" "ROS.SHX,HZTXT.SHX" "0" "0.75" "0" "n" "n" "n")
(SETQ th 3);;计算文字高度th
(setq sl 1.7);;计算一个字符的长度
);end progn
(progn
(command "-style" "Standard" "宋体" "0" "1" "0""n" "n")
(SETQ th 4.0);;计算文字高度th
(setq sl 2.1);;计算一个字符的长度
);end progn
);end if
;;计算文字长
(if (< n_max 4)
(SETQ LT (* 4 sl))
(SETQ LT (* n_max sl))
)
(if (< n_max 8)
(SETQ BH "编号")
(SETQ BH "编号")
)
;;计算数字长
(setq n 0 num_max 0)
(repeat (length list_text)
(setq nn (cdr (nth n list_text)) )
(if (> nn num_max) (setq num_max nn))
(setq n (1+ n))
);end repeat
(SETQ num_max (STRLEN (rtos num_max 2 0)) )
(if (< num_max 4)
(SETQ LN (* 4 sl))
(SETQ LN (* num_max sl))
)
;;创建表格
(setvar "OSMODE" 0);;关闭捕捉模式
(setq x0 (car pt0))
(setq y0 (car (cdr pt0)))
(setvar "clayer" "0");;切换到层“0”层
;;绘制横线
(setq i 0)
(repeat (+ (LENGTH list_text) 2)
(setq H_line_y (- y0 (* (1+ th) i)));;表格设定高5个，字高用4个
(setq H_line_x1 x0)
(setq H_line_x2 (+ x0 (* sl 4) LT LN (* sl 4) 8))
(setq H_pt1 (list H_line_x1 H_line_y) )
(setq H_pt2 (list H_line_x2 H_line_y))
(command "line"H_pt1 H_pt2 "")
(setq i (+ i 1))
)
;;绘制纵线
(setq v_pt1_x x0)
;;第一条
(setq v_pt1 (list v_pt1_x y0 ))
(setq v_pt2 (list v_pt1_x (- y0 (* (1+ th) (- i 1)))))
(command "line"V_pt1 V_pt2 "")
;;序号
(setq v_pt1_x (+ v_pt1_x (+ (* sl 4) 2) ) )
(setq v_pt1 (list v_pt1_x y0 ))
(setq v_pt2 (list v_pt1_x (- y0 (* (1+ th) (- i 1)))))
(command "line"V_pt1 V_pt2 "")
;;编号
(setq v_pt1_x (+ v_pt1_x LT 2) )
(setq v_pt1 (list v_pt1_x y0 ))
(setq v_pt2 (list v_pt1_x (- y0 (* (1+ th) (- i 1)))))
(command "line"V_pt1 V_pt2 "")
;;数量
(setq v_pt1_x (+ v_pt1_x Ln 2) )
(setq v_pt1 (list v_pt1_x y0 ))
(setq v_pt2 (list v_pt1_x (- y0 (* (1+ th) (- i 1)))))
(command "line"V_pt1 V_pt2 "")
;;备注
(setq v_pt1_x (+ v_pt1_x (+ (* sl 4) 2) ) )
(setq v_pt1 (list v_pt1_x y0 ))
(setq v_pt2 (list v_pt1_x (- y0 (* (1+ th) (- i 1)))))
(command "line"V_pt1 V_pt2 "")
;;填写数据
(IF (not (tblsearch "layer" "wz")) ;;判断是否存在“wz”图层
(command "layer" "m" "WZ" "c" "2" "WZ" "L" "CONTINUOUS""WZ" "")) ;;无则创建“wz”图层
(IF (not (tblsearch "layer" "数量")) ;;判断是否存在“数量”图层
(command "layer" "m" "数量" "c" "2" "数量" "L" "CONTINUOUS""数量" "")) ;;无则创建“数量”图层
;;表头
(setq t_pt_x x0)
(setq t_pt_y y0)
;;序号
(setq t_pt_x (+ t_pt_x (+ (* sl 2) 1) ))
(setq t_pt_y (- t_pt_y (/ (+ th 1) 2) ))
(setq t_pt (list t_pt_x t_pt_y))
(command "_text" "j" "mc" t_pt "3""0" "序号")
(setq t_pt_x (+ t_pt_x (+ (* sl 2) 1) ))
;;编号
(setq t_pt_x (+ t_pt_x (/ LT 2) 1))
(setq t_pt (list t_pt_x t_pt_y))
(command "_text" "j" "mc" t_pt "3""0" BH)
(setq t_pt_x (+ t_pt_x (/ LT 2) 1))
;;数量
(setq t_pt_x (+ t_pt_x (/ Ln 2) 1))
(setq t_pt (list t_pt_x t_pt_y))
(command "_text" "j" "mc" t_pt "3""0" "数量")
(setq t_pt_x (+ t_pt_x (/ Ln 2) 1))
;;备注
(setq t_pt_x (+ t_pt_x (+ (* sl 2) 1) ))
(setq t_pt (list t_pt_x t_pt_y))
(command "_text" "j" "mc" t_pt "3""0" "备注")
(setq t_pt_x (+ t_pt_x (+ (* sl 2) 1) ))
(setq t_pt_y (- t_pt_y (/ (+ th 1) 2) ))
;填写统计部分
(setq n 0)
(repeat (length list_text)
(setq t_pt_x x0)
(setvar "clayer" "WZ")
;;序号
(setq n (1+ n))
(setq t_pt_x (+ t_pt_x (+ (* sl 2) 1) ))
(setq t_pt_y (- t_pt_y (/ (+ th 1) 2) ))
(setq t_pt (list t_pt_x t_pt_y))
(command "_text" "j" "mc" t_pt "3""0" n )
(setq t_pt_x (+ t_pt_x (+ (* sl 2) 1) ))
;;文字
(setq t_pt_x (+ t_pt_x (/ LT 2) 1))
(setq t_pt (list t_pt_x t_pt_y))
(command "_text" "j" "mc" t_pt "3""0" (car (nth (1- n) list_text)))
(setq t_pt_x (+ t_pt_x (/ LT 2) 1))
;;数量
(setq t_pt_x (+ t_pt_x (/ LN 2) 1))
(setq t_pt (list t_pt_x t_pt_y))
(setvar "clayer" "数量")
(command "_text" "j" "mc" t_pt "3""0" (cdr (nth (1- n) list_text)))
(setvar "clayer" "WZ")
(setq t_pt_x (+ t_pt_x (/ LN 2) 1))
(setq t_pt_y (- t_pt_y (/ (+ th 1) 2) ))
);end repeat
(command "undo" "e" )
(setvar "clayer" olayer) ;;还原颜色
(setvar "CECOLOR" ocolor) ;;还原颜色
(setvar "osmode" odosm) ;;还原捕捉方式
(setvar "cmdecho" odcmd) ;;还原命令行回显
(princ)
);end defun
程序出错 start4444 发表于 2019-10-23 14:04
程序出错
出错了吗我重新发下 start4444 发表于 2019-10-23 14:04
程序出错
你好再看下啊0000 有点麻烦,这个程序是把字高跟字宽给写死到程序里了,并且后面计算行宽行高的时候也是把冗余量写死了.
两种改法,一个是字高字宽根据实际高度获取,并且把后面的计算部分例如
(setq H_line_y (- y0 (* (1+ th) i)))改成
(setq H_line_y (- y0 (* (* 1.2 th) i)))
第二种是在程序全部完成以后将所有新生成的内容,放大100倍.
其中
(WHILE (= pt0 nil) (setq pt0 (GETPOINT "\n指定表格位置:")) )
pt0保存插入点,也就是缩放的基准点,也是所有新生成的内容的左上点.
将以下代码
(setvar "clayer" "0");;切换到层“0”层
修改为
(IF (not (tblsearch "layer" "bgx")) ;;判断是否存在“bgx”图层
(command "layer" "m" "bgx" "c" "2" "WZ" "L" "CONTINUOUS""WZ" "")) ;;无则创建“bgx”图层
(setvar "clayer" "bgx");;切换到层“0”层
将表格的图层换个新层方便后面ssget筛选.
(repeat (+ (LENGTH list_text) 2)
......
(command "line"H_pt1 H_pt2 "")
(setq i (+ i 1))
)
repeat完成后的H_pt2 应该是所有内容的右下点
在函数末尾(command "undo" "e" )前加入以下代码
(setq ss1 (ssget "C" pt0 h_pt2 (list (cons 8 "bgx,数量,WZ"))) )
(command "SCALE" ss1 "" pt0 100)
这样程序运行时会根据原程序生成表格,然后放大
但是容易出bug,如果在选择范围内有其他的这三个图层的对象,会被一并放大.
第二个办法其实也可以在每次生成对象以后用entlast加入到一个选择集里,这样不会出错,但是改动量太大,还不如用方法一.
页:
[1]