明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 46341|回复: 415

[源码] 插入符号

    [复制链接]
发表于 2014-7-10 10:40 | 显示全部楼层 |阅读模式
本帖最后由 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

点评

z真好的程序  发表于 2015-5-26 22:46

评分

参与人数 16明经币 +16 金钱 +86 收起 理由
songyujie928 + 1 很给力!
sz721 + 1 赞一个!
baoxiaozhong + 1 + 20 很给力!
bzhjl + 1 很给力!
spp_wall + 10 好像不能用吧!
张和平 + 1 + 50 很给力!
kexiya123 + 1 + 6 很给力!
edata + 1 很给力!
669423907 + 1 很给力!
机械工程师 + 1 很给力!

查看全部评分

"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2020-12-4 23:27 | 显示全部楼层
http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTEyMDY0fGY2NzQyMDNlNGU5Y2FiZTU0MTA2YjA4ZmRiZGM0YTBmfDE3MTE3MjA4MjE%3D&request=yes&_f=.png

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2018-9-5 18:16 | 显示全部楼层
taoyi0727 发表于 2018-9-5 13:23
好东西  研究下

大神真是好学呀  
发表于 2014-7-10 11:05 | 显示全部楼层
太好了,正需要这个
发表于 2014-7-10 11:06 | 显示全部楼层
快跳出来吧
发表于 2014-7-10 11:10 | 显示全部楼层
支持郎大师!
发表于 2014-7-10 11:22 | 显示全部楼层
太好了,学习一下
发表于 2014-7-10 11:33 来自手机 | 显示全部楼层
看看,回复看看
发表于 2014-7-10 11:36 | 显示全部楼层
希腊字母等也加入啊。
发表于 2014-7-10 11:41 | 显示全部楼层
谢谢,正需要这个
发表于 2014-7-10 11:55 来自手机 | 显示全部楼层
回复看帖,
发表于 2014-7-10 12:00 | 显示全部楼层
学习学习再学习
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 22:00 , Processed in 0.248302 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表