球标编号 BUG 望 修复
本帖最后由 纵横八方 于 2022-10-18 14:09 编辑;函数：lch:getfile 功能：读取文件并按行将文件转换为表
;返回值：返回一个表，文件中一行被转换为表中的一个项，如果文件不存在，则返回nil
;语法：(lch:getfile files) 参数：files：文本文件名，如未指定路径则自动在搜索路径中查找文件
;示例：(lch:getfile "tyl.ini")
;函数代码：
(defun lch:getfile(files / tmplst x fn)
(setq files(findfile files))
(if files
(progn
(setq fn (openfiles "r"))
(while (setq x (read-line fn))
(setq tmplst(append tmplst(list x)))
)
(close fn)
tmplst
)
nil
)
)
;S值为 "LAYER"、"LTYPE"、"VIEW"、"STYLE"、"BLOCK"、"UCS"、"APPID"、"DIMSTYLE" 和 "VPORT"。
(defun lch:get-table (S / sty style sty_list)
(setq sty_list nil
sty (tblnext S t)
)
(setq style (cdr (assoc 2 sty)))
(while style
(if (/= "" style)
(setq sty_list (append
sty_list
(list style)
)
)
)
(setq sty (tblnext S))
(setq style (cdr (assoc 2 sty)))
) ; end while]
(setq sty_list (ACAD_Strlsort sty_list))
sty_list
)
;;语法 (lch:img img_key slide cobak)
;;img_key 图像控件关键字
;;slide 幻灯片名字
;;cobak 图像控件底色
;;功能：对话框图像初始化
(defun lch:img (imgkey slide cobak /x1y1)
(setq x1(dimx_tile imgkey))
(setq y1(dimy_tile imgkey))
(start_image imgkey)
(fill_image 0 0 x1 y1 cobak)
(slide_image 0 0 x1 y1 slide)
(end_image)
)
;;画球标编号
(defun c:ee()
(prompt "LCH工具箱-球标编号V0.1\n")
(ball:number);对话框
(if (> ball_id 0)
(ball_qb)
)
(princ)
)
(defun ball_qb ();画球标编号程序
(defun *error* (msg)
(setvar "clayer" mylay)
(setvar "dimasz" myasz)
(setvar "dimclrd" myclrd)
(setvar "DIMLDRBLK" myblk)
(command "._undo" "_E")
(setvar "cmdecho" 1)
(if (/= pt nil)
(progn
(if (or (= ball_id 2) (= ball_id 3))
(entdel e1)
)
(entdel e2)
(entdel e3)
)
);if
;(princ (msg))
)
(setvar "cmdecho" 0)
(command "._undo" "_BE")
(setq mylay (getvar "clayer"))
(setq myblk (getvar "dimldrblk"))
(if (= myblk "")
(setq myblk ".")
)
(setq myasz (getvar "dimasz"))
(setq myclrd (getvar "dimclrd"))
(if (not (tblsearch "layer" "ball" ))
(command "layer" "new" "ball" "s" "ball" "C" 7 "" "L" "CONTINUOUS" "" "LW" 0.13 "" "")
)
(setvar "clayer" "ball")
(while
(if (= ball_id 1)
(setq pt (list 0 0))
(progn
(setq pt (getpoint (strcat "\n->当前编号:" (itoa getnum) "文字高度:" txthei"\n->指定序号引线起点或<退出>:")))
(setq lst (entget
(entmakex
(list
'(0 . "LEADER")
'(100 . "AcDbEntity")
'(100 . "AcDbLeader")
(cons 10 pt)
(cons 10 (polar pt (/ pi 4) 10))
);list
);entmakex
);entget
);setq
(setq oldlead (vlax-ename->vla-object (entlast)))
(if (= ball_id 2);箭头类型
(vla-put-ArrowheadType oldlead acArrowdot);圆点箭头
(vla-put-ArrowheadType oldlead acArrowdefault);实心箭头
)
(vla-put-ArrowheadSize oldlead (atof getsiz));箭头大小
(vla-put-DimensionLineColor oldlead (atof cgr4));引线颜色
(setq e1 (entlast))
);pr
);if
(setq lst1 (entget
(entmakex
(list
'(0 . "circle")
(cons 62 (atoi cgr5));圆颜色
(cons 10 pt);圆心坐标
(cons 40 (atof txthei));圆半径
);list
);entmakex
);entget
);setq
(setq e2 (entlast))
(setq lst2 (entget
(entmakex
(list
'(0 . "text")
(cons 1 (itoa getnum));编号
(cons 7 txtsty);文字样式
(cons 62 (atoi cgr6));文字颜色
(cons 10 pt);文字中心坐标
(cons 40 (atof txthei));文字高度
'(71 . 0)
'(72 . 1)
'(73 . 2)
(cons 41 (atof txtwid));宽度因子
(cons 11 pt);文字中心坐标
);list
);entmakex
);entget
);setq
(setq oldtext (vlax-ename->vla-object (entlast)))
(setq e3 (entlast))
(princ "\n->指定序号标注位置或<退出>:")
(setq tag T)
(while tag
(setq code (grread T 15 0));;;读取输入
(cond
((or (= (car code) 5) (= (car code) 3))
(if (= (car code) 3) (setq tag nil));if
(if serialnumberpt1
(progn
(if (< (- (car serialnumberpt1) (* 1.2 (atof txthei))) (car (cadr code)) (+ (car serialnumberpt1) (* 1.2 (atof txthei)))) ;X坐标范围
(progn
(if (or (< (cadr (cadr code)) (- (cadr serialnumberpt1) (* 2.5 (atof txthei))))
(> (cadr (cadr code)) (+ (cadr serialnumberpt1) (* 2.5 (atof txthei))))
);or
(setq serialnumberpt (list (car serialnumberpt1) (cadr (cadr code))))
);if
(if (< (- (cadr serialnumberpt1) (* 2.5 (atof txthei))) (cadr (cadr code)) (cadr serialnumberpt1))
(setq serialnumberpt (list (car serialnumberpt1) (- (cadr serialnumberpt1) (* 2.5 (atof txthei)))))
);if
(if (> (+ (cadr serialnumberpt1) (* 2.5 (atof txthei))) (cadr (cadr code)) (cadr serialnumberpt1))
(setq serialnumberpt (list (car serialnumberpt1) (+ (cadr serialnumberpt1) (* 2.5 (atof txthei)))))
);if
);pr
);if
(if (< (- (cadr serialnumberpt1) (* 1.2 (atof txthei))) (cadr (cadr code)) (+ (cadr serialnumberpt1) (* 1.2 (atof txthei)))) ;Y坐标范围
(progn
(if (or (< (car (cadr code)) (- (car serialnumberpt1) (* 2.5 (atof txthei))))
(> (car (cadr code)) (+ (car serialnumberpt1) (* 2.5 (atof txthei))))
);or
(setq serialnumberpt (list (car (cadr code)) (cadr serialnumberpt1)))
);if
(if (< (- (car serialnumberpt1) (* 2.5 (atof txthei))) (car (cadr code)) (car serialnumberpt1))
(setq serialnumberpt (list (- (car serialnumberpt1) (* 2.5 (atof txthei))) (cadr serialnumberpt1)))
);if
(if (> (+ (car serialnumberpt1) (* 2.5 (atof txthei))) (car (cadr code)) (car serialnumberpt1))
(setq serialnumberpt (list (+ (car serialnumberpt1) (* 2.5 (atof txthei))) (cadr serialnumberpt1)))
);if
);pr
);if
(if (and (or (<= (car (cadr code)) (- (car serialnumberpt1) (* 1.2 (atof txthei)))) (>= (car (cadr code)) (+ (car serialnumberpt1) (* 1.2 (atof txthei)))))
(or (<= (cadr (cadr code)) (- (cadr serialnumberpt1) (* 1.2 (atof txthei)))) (>= (cadr (cadr code)) (+ (cadr serialnumberpt1) (* 1.2 (atof txthei)))))
);and
(setq serialnumberpt (cadr code))
);if
);pr
(setq serialnumberpt (cadr code))
);if
(if (or (= ball_id 2) (= ball_id 3))
(progn
(entmod (subst
(cons 10 (polar pt (angle pt serialnumberpt) (- (distance pt serialnumberpt) (atof txthei)) ))
(cons 10 (polar pt (/ pi 4) 10))
lst
) ;subst
) ;entmod
(entupd (cdr (assoc -1 lst)))
);pr
);if
(entmod (subst
(cons 10 serialnumberpt)
(assoc 10 lst1)
lst1
) ;subst
) ;entmod
(entupd (cdr (assoc -1 lst1)))
(vla-put-textalignmentpoint oldtext (vlax-3d-point serialnumberpt))
);or
);cond
);while
(setq pt nil)
(setq getnum (+ 1 getnum))
(setq serialnumberpt1 serialnumberpt)
);while
(setvar "clayer" mylay)
(setvar "dimasz" myasz)
(setvar "dimclrd" myclrd)
(setvar "DIMLDRBLK" myblk)
(command "._undo" "_E")
(setvar "cmdecho" 1)
;(princ)
) ;defun
(defun ball:number ();对话框
(setq fname (vl-filename-mktemp nil nil ".dcl"))
(setq fn (open fname "w"))
(write-line "ballnumber:dialog {" fn)
(write-line " label = \"LCH工具箱-球标编号V0.1\" ;" fn)
(write-line " :column {" fn)
(write-line " :row {" fn)
(write-line " :image_button {" fn)
(write-line " aspect_ratio = 1 ;" fn)
(write-line " color = -2 ;" fn)
(write-line " fixed_width = true ;" fn)
(write-line " key = \"gread1\" ;" fn)
(write-line " width = 23 ;" fn)
(write-line " }" fn)
(write-line " :image_button {" fn)
(write-line " aspect_ratio = 1 ;" fn)
(write-line " color = -2 ;" fn)
(write-line " fixed_width = true ;" fn)
(write-line " key = \"gread2\" ;" fn)
(write-line " width = 23 ;" fn)
(write-line " }" fn)
(write-line " :image_button {" fn)
(write-line " aspect_ratio = 1 ;" fn)
(write-line " color = -2 ;" fn)
(write-line " fixed_width = true ;" fn)
(write-line " key = \"gread3\" ;" fn)
(write-line " width = 23 ;" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " :column {" fn)
(write-line " fixed_height = true ;" fn)
(write-line " height = 7 ;" fn)
(write-line " label = \"球标编号设置\" ;" fn)
(write-line " :row {" fn)
(write-line " :text {" fn)
(write-line " fixed_width = true ;" fn)
(write-line " label = \"引线颜色\" ;" fn)
(write-line " width = 5 ;" fn)
(write-line " }" fn)
(write-line " :image_button {" fn)
(write-line " fixed_height = true ;" fn)
(write-line " fixed_width = true ;" fn)
(write-line " height = 2 ;" fn)
(write-line " key = \"gread4\" ;" fn)
(write-line " width = 10 ;" fn)
(write-line " }" fn)
(write-line " :text {" fn)
(write-line " fixed_width = true ;" fn)
(write-line " label = \"球号颜色\" ;" fn)
(write-line " width = 5 ;" fn)
(write-line " }" fn)
(write-line " :image_button {" fn)
(write-line " fixed_height = true ;" fn)
(write-line " fixed_width = true ;" fn)
(write-line " height = 2 ;" fn)
(write-line " key = \"gread5\" ;" fn)
(write-line " width = 10 ;" fn)
(write-line " }" fn)
(write-line " :text {" fn)
(write-line " fixed_width = true ;" fn)
(write-line " label = \"文字颜色\" ;" fn)
(write-line " width = 5 ;" fn)
(write-line " }" fn)
(write-line " :image_button {" fn)
(write-line " fixed_height = true ;" fn)
(write-line " fixed_width = true ;" fn)
(write-line " height = 2 ;" fn)
(write-line " key = \"gread6\" ;" fn)
(write-line " width = 10 ;" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " :row {" fn)
(write-line " :popup_list {" fn)
(write-line " fixed_width = true ;" fn)
(write-line " key = \"getstyle\" ;" fn)
(write-line " label = \"文字样式\" ;" fn)
(write-line " width = 24 ;" fn)
(write-line " }" fn)
(write-line " :edit_box {" fn)
(write-line " fixed_width = true ;" fn)
(write-line " key = \"getheight\" ;" fn)
(write-line " label = \"文字高度\" ;" fn)
(write-line " width = 20 ;" fn)
(write-line " }" fn)
(write-line " :edit_box {" fn)
(write-line " fixed_width = true ;" fn)
(write-line " key = \"getwidth\" ;" fn)
(write-line " label = \"宽度因子\" ;" fn)
(write-line " width = 20 ;" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " :row {" fn)
(write-line " :edit_box {" fn)
(write-line " fixed_width = true ;" fn)
(write-line " key = \"getsize\" ;" fn)
(write-line " label = \"箭头大小\" ;" fn)
(write-line " width = 24 ;" fn)
(write-line " }" fn)
(write-line " :edit_box {" fn)
(write-line " fixed_width = true ;" fn)
(write-line " key = \"getnumber\" ;" fn)
(write-line " label = \"起始编号\" ;" fn)
(write-line " width = 20 ;" fn)
(write-line " }" fn)
(write-line " :text {" fn)
(write-line " width = 21 ;" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " :text {" fn)
(write-line " height = 10 ;" fn)
(write-line " value = \"\\n使用说明:\\n1、球标编号设置部分设置好后，以后打开任何一份图纸都可以用这个设置来标注\\n2、标注球号时鼠标在上一个球号附近会自动水平或垂直对齐\\n3、感谢你的使用\\n\\n 作者：LCH\\n 制作日期:2016-01-01\" ;" fn)
(write-line " }" fn)
(write-line " }" fn)
(write-line " :button {" fn)
(write-line " is_cancel = true ;" fn)
(write-line " height = 3 ;" fn)
(write-line " width = 10 ;" fn)
(write-line " key = \"cancel\" ;" fn)
(write-line " label = \"退出\" ;" fn)
(write-line " }" fn)
(write-line "}" fn)
(close fn)
(setq dclid (load_dialog fname))
(new_dialog "ballnumber" dclid)
(ball_data);初始化数据
(ball_action);按键处理
(setq ball_id (start_dialog))
(unload_dialog dclid)
(vl-file-delete fname)
(princ)
)
(defun ball_data();初始化数据
(setq ball_lst (lch:getfile "D:\\Program Files\\ballnumber.dat"))
(setq stylelst (lch:get-table "style"))
(if (= ball_lst nil)
(progn
(setq numblst (list "4" "4" "6" (car stylelst) "10" "0.67" "10"))
(setq ball_lst numblst)
(setq ff (open "D:\\Program Files\\ballnumber.dat" "w"))
(setq i 0)
(while (< i (length numblst))
(write-line (nth i numblst) ff)
(setq i (+ 1 i))
);wh
(close ff)
);pr
);if
(setq cgr4 (atoi (nth 0 ball_lst)));引线颜色
(setq cgr5 (atoi (nth 1 ball_lst)));球号颜色
(setq cgr6 (atoi (nth 2 ball_lst)));文字颜色
(setq txtsty (nth 3 ball_lst));文字样式
(setq txthei (nth 4 ball_lst));文字高度
(setq txtwid (nth 5 ball_lst));宽度因子
(setq bousiz (nth 6 ball_lst));箭头大小
(lch:img "gread1" "D:\\lchwz\\球标编号\\ball-1" -2);无箭头球标编号幻灯片
(lch:img "gread2" "D:\\lchwz\\球标编号\\ball-2" -2);圆点箭头球标编号幻灯片
(lch:img "gread3" "D:\\lchwz\\球标编号\\ball-3" -2);实心箭头球标编号幻灯片
(c_img "gread4" cgr4);引线颜色
(c_img "gread5" cgr5);球号颜色
(c_img "gread6" cgr6);文字颜色
;处理文字样式列表
(setq lch_in 0)
(start_list "getstyle" 3 0)
(repeat (length stylelst)
(add_list (nth lch_in stylelst))
(setq lch_in (1+ lch_in))
);re
(end_list)
;提取文字样式
(if (= (vl-position txtsty stylelst) nil)
(setq getstyle "0")
(setq getstyle (itoa (vl-position txtsty stylelst)))
)
(set_tile "getstyle" getstyle);文字样式
(set_tile "getheight" txthei);文字高度
(set_tile "getwidth" txtwid);宽度因子
(set_tile "getsize" bousiz);箭头大小
(setq sswz nil)
(setq wzname nil)
(setq sswz (ssget "X" '((0 . "text") (8 . "ball") )))
(if sswz
(progn
(setq i 0)
(repeat (sslength sswz)
(setq en (entget (ssname sswz i)))
(setq wzname (cons (atoi (cdr (assoc 1 en))) wzname))
(setq i (1+ i))
);re
(setq getnum (+ (car (vl-sort wzname '>)) 1))
(setq i1 0)
(repeat (sslength sswz)
(setq en1 (entget (ssname sswz i1)))
(setq wzname1 (cdr (assoc 1 en1) ))
(if (= wzname1 (itoa (- getnum 1)))
(setq serialnumberpt1 (cdr (assoc 11 en1)))
);if
(setq i (1+ i1))
);re
);pr
(progn
(setq serialnumberpt1 nil)
(setq getnum 1)
);pr
);if
(set_tile "getnumber" (itoa getnum));起始编号
);de
(defun ball_action ();按键处理
(action_tile "gread1" "(ball_getaction) (ball_save) (done_dialog 1)");无箭头球标编号
(action_tile "gread2" "(ball_getaction) (ball_save) (done_dialog 2)");圆点箭头球标编号
(action_tile "gread3" "(ball_getaction) (ball_save) (done_dialog 3)");实心箭头球标编号
(action_tile "gread4" "(setq cgr4 (c_c cgr4)) (c_img $key cgr4)");引线颜色
(action_tile "gread5" "(setq cgr5 (c_c cgr5)) (c_img $key cgr5)");球号颜色
(action_tile "gread6" "(setq cgr6 (c_c cgr6)) (c_img $key cgr6)");文字颜色
(action_tile "cancel" "(ball_getaction) (ball_save) (done_dialog -1)");退出按钮
)
(defun ball_getaction ();提取数据
(setq cgr4 (itoa cgr4));引线颜色
(setq cgr5 (itoa cgr5));球号颜色
(setq cgr6 (itoa cgr6));文字颜色
(setq txtsty (nth (atoi (get_tile "getstyle")) stylelst));文字样式
(setq txthei (get_tile "getheight"));文字高度
(setq txtwid (get_tile "getwidth"));宽度因子
(setq getsiz (get_tile "getsize"));箭头大小
(setq getnum (atoi (get_tile "getnumber")));起始编号
);de提取数据
(defun ball_save();保存数据
(setq savenum (list cgr4 cgr5 cgr6 txtsty txthei txtwid getsiz))
(setq ff (open "D:\\Program Files\\ballnumber.dat" "w"))
(setq i 0)
(while (< i (length savenum))
(write-line (nth i savenum) ff)
(setq i (+ 1 i))
);wh
(close ff)
)
(defun c_c(color / ccc)
(setq ccc(acad_colordlg color nil))
(if (not ccc) (setq ccc color))
ccc
)
(defun c_img (key color) ;定义初始化颜色图像按钮数
(if color
(progn
(start_image key)
(fill_image 0 0 (dimx_tile key) (dimy_tile key) color)
(end_image)
)
)
)
RE: 球标编号幻灯片
球标编号幻灯片......顶起来哇！
顶起来哇！ 估计有点难了，自己试试把
页:
[1]