马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
x
本帖最后由 newer 于 2017-9-11 22:27 编辑
函数 XD::Table:MakeFromList 见:http://bbs.xdcad.net/thread-705792-1-1.html
[sell=5](defun c:XDTB_TJCir ( / #height class1 class2 ents lst pt ss str1 str2 tlst2 val x y)
(defun _maketable (lst)
(if (setq pt (getpoint "\n表格插入点<退出>:"))
(progn
(setq lst (xd::table:celltile (list "序号" "编号" "孔径" "X坐标" "Y坐标") 1 lst)
lst (cons (list "孔编号表" nil nil nil nil) lst)
)
(XD::Table:MakeFromList lst (trans pt 1 0) #xd_var_text_height (/ #xd_var_text_height 2.0))
)
)
)
(defun _format (val)
(xdrx_string_regexpr "(?<=\\.[0-9]+)0{1,}$" val "")
)
(defun _write (lst)
(setq tlst2 nil)
(setq class1 "A")
(mapcar
'(lambda (x)
(setq class2 "0")
(mapcar
'(lambda (y /)
(setq str1 (strcat class1 (setq class2 (itoa (1+
(atoi class2)
)
)
)
)
)
(xdrx_text_make (cadr y) str1 #xd_var_text_height (xd::ucs:angle))
(XD::Text:AdjustAlignMent (entlast) 1 2)
(xdrx_entity_move (entlast) (trans (xd::geom:get9pt (entlast) 5) 1 0) (cadr y) )
(setq str2 (strcat "Φ" (rtos (* 2 (last y)) 2 1))
y (trans (cadr y) 0 1))
(setq tlst2 (cons (list str1 str2
(_format (rtos (car y) 2 4)) (_format (rtos
(cadr y)
2 4)
)
) tlst2
)
)
)
x
)
(setq class1 (chr (1+ (ascii class1))))
)
lst
)
(_maketable (reverse tlst2))
)
(if (not #xd_var_text_height)
(setq #xd_var_text_height 3.5)
)
(if (setq val (getreal (xdrx_prompt "\n输入字高<" #xd_var_text_height ">:" t)))
(setq #xd_var_text_height val)
)
(if (setq ss (xd::ssget "\n选取统计的圆<退出>" '(((0 . "circle")))))
(progn
(xdrx_begin)
(xdrx_sysvar_push '("dimzin" 0))
(setq ents (mapcar
'(lambda (x)
(list (xdrx_getpropertyvalue x "area") (cons x
(xdrx_getpropertyvalue x "center" "radius")
)
)
)
(xdrx_pickset->ents ss)
)
)
(setq ents (xd::list:groupbyindex ents 0.0))
(setq ents (vl-sort ents '(lambda (x y)
(< (car x) (car y))
)
)
)
(setq ents (mapcar
'cdr
ents
)
)
(xd::text:init 1)
(_write ents)
(xdrx_end)
)
)
(princ)
)
[/sell] |