- 积分
- 26899
- 明经币
- 个
- 注册时间
- 2003-8-26
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 langjs 于 2014-9-23 14:18 编辑
把WORD的符号弄了一些过来，仅适用于单行文本。
补一张图：
;;; ================================
;;; 单行文本插入符号。左键或A、D选择
;;; 位置,S或右键弹出对话框。双击插入
;;; by:langjs
;;; ================================
;;; ================================
;;; 单行文本插入符号。左键或a、d选择
;;; 位置,s或右键弹出对话框。双击插入
;;; by:langjs
;;; ================================
(defun c:aa (/ #errins $orr bb bu code d data dcl_re dclname dlg ent ent1 ent2 f gr h i j key loop lst lst1 lst2 n
name name2 newlist pt pt0 pt2 pt3 ptlst rr ss str str0 str1 str2 x )
(defun jspt (pt w ww)
(list (+ (car pt) w) (+ (cadr pt) ww))
)
(defun #errins (s)
(command ".UNDO" "E")(command ".UNDO" "") (setq *error* $orr))
(defun insdcl (/ dclname dlg f x)
(defun show_list (key newlist)
(start_list key)(mapcar 'add_list newlist ) (end_list))
(defun insdcl01 (i)
(if (/= i bz001) (setq bz002 "0"))
(setq lst2 (cdr (nth (atoi i) lst)) str0 (nth (atoi bz002) lst2) bz001 i)
(show_list "e03" lst2)
(set_tile "e01" (strcat str1 str0 str2)) (set_tile "e03" bz002))
(defun insdcl02 (j)
(setq str0 (nth (atoi j) lst2) bz002 j )
(set_tile "e01" (strcat str1 str0 str2)))
(setq lst '()
lst (cons (list "常用符号" "Ф" "R" "M" "°" "±" "平方" "立方") lst)
lst (cons (list "数学符号" "=" "≈" "≠" "＜" "＞" "≤" "≥" "≮" "≯" "±" "+" "-" "×" "÷" "∫" "∮"
"∝" "∞" "∑" "∠" "∥" ) lst )
lst (cons (list "数字符号" "Ⅰ" "Ⅱ" "Ⅲ" "Ⅳ" "Ⅴ" "Ⅵ" "Ⅶ" "Ⅷ" "Ⅸ" "Ⅹ" "Ⅺ" "Ⅻ" "①" "②" "③" "④"
"⑤" "⑥" "⑦" "⑧" "⑨" "⑩" "⑴" "⑵" "⑶" "⑷" "⑸" "⑹" "⑺" "⑻" "⑼" "⑽" "⑾" "⑿" ) lst )
lst (cons (list "单位符号" "°" "′" "″" "＄" "￥" "℃" "%" "‰" "mm" "cm" "km" "mg" "kg") lst)
lst (cons (list "标点符号" "，" "、" "。" "；" "：" "？" "！" "…" "（" "）" "｛" "｝" "【" "】" "《" "》"
"『" "』") lst)
lst (cons (list "希腊字母" "Δ" "Λ" "Ξ" "Ο" "Π" "Ψ" "Ω" "Σ" "α" "β" "γ" "δ" "ε" "ζ" "η" "θ" "κ" "λ" "μ"
"ξ" "π" "ρ" "σ" "τ" "υ" "φ" "χ" "ψ" "ω" ) lst )
lst (cons (list "特殊符号" "＃" "＆" "＊" "※" "§" "○" "●" "△" "▲" "◎" "☆" "◇" "◆" "□" "■" "♀" "♂"
"↑" "↓" "←" "→" "↖" "↗" "↙" "↘" ) lst )
lst (cons (list "电子签名" "langjs" "langjs""langjs""langjs""langjs""langjs") lst)
lst (cons (list "单位名称" "XX有限公司" "XX有限公司""XX有限公司""XX有限公司""XX有限公司") lst)
lst (reverse lst)
)
(setq lst1 (mapcar 'car lst ) lst2 (cdr (car lst)) dclname (vl-filename-mktemp "re-dcl-tmp.dcl") f (open dclname "w"))
(foreach x (list "RENAME:dialog {" " label = \"插入符号\" ;" " :edit_box { key = \"e01\" ; }" " :row {"
" :list_box { key = \"e02\" ; width = 15 ; height = 10 ;}"
" :list_box { key = \"e03\" ; width = 15 ; height = 10 ;allow_accept=true;}}" " :row {"
" :button {is_default = true ; key = \"e04\" ; label = \"确认\" ; }"
" :button { is_cancel = true ; key = \"e05\" ; label = \"取消\" ; }" " }}" )
(write-line x f))
(close f)
(setq dcl_re (load_dialog dclname))
(new_dialog "RENAME" dcl_re)
(show_list "e02" lst1)
(if (null bz001) (setq bz001 "0"))
(if (null bz002) (setq bz002 "0"))
(set_tile "e02" bz001)
(insdcl01 bz001)
(action_tile "e02" "(insdcl01 $value ) ")
(action_tile "e03" "(insdcl02 $value ) ")
(action_tile "accept" "(setq dcl_pt (done_dialog 1))")
(action_tile "cancel" "(setq dcl_pt (done_dialog 2))")
(setq bb (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
(if (= bb 1)
(progn(if (setq x (cadr (assoc str0 (list '("Ф" "%%C") '("°" "%%D") '("±" "%%P"))))) (setq str0 x))
(if (setq x (cadr (assoc str0 (list '("平方" "2") '("立方" "3")))))
(progn (setq str0 " " h (dxf ent 40) pt3 (polar pt2 (+ rr 1.42) (* 0.6 h)))
(entmake (emod (emod (emod (cdr ent) 40 (* 0.5 h)) 10 pt3) 1 x))))
(entmod (emod ent 1 (strcat str1 str0 str2)))
(if name2 (entdel name2))
(setq loop nil)))
(if (and (= bu 2) (= bb 0))(exit))
)
(defun dxf (ent n)
(if (= (type ent) 'ename)(setq ent (entget ent))) (cdr (assoc n ent)))
(defun emod (ent i n)
(subst (cons i n)(assoc i ent) ent ))
(setq $orr *error* *error* #errins )
(setvar "cmdecho" 0) ; 主程序
(command ".UNDO" "BE")
(princ "\n 选择单行文本,或右键:")
(setq loop t bu 1)
(while loop
(setq gr (grread t 15 2) pt (cadr gr))
(cond
((= (car gr) 3)
(setq d (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) (getvar "pickbox")))
(setq ptlst (list (jspt pt d d) (jspt pt (* -1 d) d) (jspt pt (* -1 d) (* -1 d)) (jspt pt d (* -1 d)) (jspt pt (* -1 d) d)))
(if (setq ss (ssget "F" ptlst '((0 . "TEXT")))) (setq name (ssname ss 0)loop nil )))
((member (car gr) '(11 25))
(command "text" '(0.0 0.0) "" 0.0 "Ⅰ" )
(setq name (entlast) bu 2 loop nil))))
(setq ent (entget name)str (dxf ent 1)pt0 (dxf ent 10)rr (dxf ent 50) str1 "" loop t i 0 )
(if (= bu 2)
(progn
(setq str2 "")
(insdcl)
(setq loop t)
(while loop
(setq gr (grread t 15 0) data (cadr gr))
(cond
((= (car gr) 3) (setq loop nil))
((= (car gr) 5) (entmod (emod (emod ent 1 str0) 10 data)))
((member (car gr) '(11 25)) (setq loop nil) (exit))))))
(princ "\n 指定光标位置或 [左移(A)/右移(D)/确定(S)]:")
(while loop
(setq i (1+ i))
(if (> (ascii (substr str i 1)) 160) (setq i (1+ i)))
(setq str1 (substr str 1 i) str2 (substr str (1+ i)) pt2 (polar pt0 rr (car (cadr (textbox (emod ent 1 str1))))))
(cond
((or(>= i (strlen str))(>= (car pt2) (car pt)))
(entmod (emod ent 1 (strcat str1 " " str2)))
(if (assoc 62 ent)
(setq ent1 (emod (cdr ent) 62 6))
(setq ent1 (append (cdr ent)(list (cons 62 6)))))
(entmake (emod (emod ent1 1 "Ⅰ") 10 pt2))
(setq name2 (entlast) loop nil)
(redraw name2 3))))
(if name2 (setq ent2 (entget name2) loop t ))
(while loop
(setq gr (grread t 15 0) code (car gr) data (cadr gr))
(cond
((= code 2) ; 键盘
(cond
((member (vl-list->string (cdr gr)) '("A" "a"))
(if (<= i 0) (setq i (1+ (strlen str))))
(setq i (1- i))
(if (> (ascii (substr str (1+ i) 1)) 160) (setq i (- i 1)))
(if (= i 0)
(setq str1 "" pt2 pt0 )
(setq str1 (substr str 1 i) pt2 (polar pt0 rr (car (cadr (textbox (emod ent 1 str1)))))))
(setq str2 (substr str (1+ i)))
(entmod (emod ent 1 (strcat str1 " " str2)))
(entmod (emod ent2 10 pt2))
(redraw name2 3))
((member (vl-list->string (cdr gr)) '("D" "d"))
(setq i (1+ i))
(if (> (ascii (substr str i 1)) 160) (setq i (1+ i)))
(if (> i (strlen str)) (setq i 0 str1 "" pt2 pt0 )
(setq str1 (substr str 1 i) pt2 (polar pt0 rr (car (cadr (textbox (emod ent 1 str1)))))))
(setq str2 (substr str (1+ i)))
(entmod (emod ent 1 (strcat str1 " " str2)))
(entmod (emod ent2 10 pt2))
(redraw name2 3))
((member (vl-list->string (cdr gr)) '("S" "s"))
(insdcl))))
((= code 3) ; 左击
(if (> (car data) (car (dxf name2 10)))
(setq pt (list (- (car data) (car (cadr (textbox (emod ent 1 "Ⅰ"))))) (cadr pt0)))
(setq pt (list (car data) (cadr pt0))))
(setq loop t str1 "" i 0)
(while loop
(setq i (1+ i) j (car (cadr (textbox (emod ent 1 "Ⅰ")))))
(if (> (ascii (substr str i 1)) 160) (setq i (1+ i) j (* 2 j)))
(setq str1 (substr str 1 i) str2 (substr str (1+ i))
pt2 (polar pt0 rr (car (cadr (textbox (emod ent 1 str1))))))
(cond ((or (>= i (strlen str))(>= (+ (car pt2) j) (car pt))) (setq loop nil))))
(if (< (car data) (car pt0)) (setq str1 "" pt2 pt0 i 0 ))
(setq str2 (substr str (1+ i)))
(entmod (emod ent 1 (strcat str1 " " str2)))
(entmod (emod ent2 10 pt2))
(redraw name2 3)
(setq loop t) )
((member code '(11 25)) ; 右击
(insdcl))))
(setq *error* $orr)
(command ".UNDO" "E")
(princ)
) |
本帖子中包含更多资源
您需要 登录 才可以下载或查看，没有账号？注册
x
评分
-
查看全部评分
|
[复制链接]
发表于 2014-7-10 10:40:30
置顶卡
变色卡
显身卡
发表于 2020-12-4 23:27:52
