修改文字上下划线---击文字上部为上划线，下部为下划线,右击...

自贡黄明儒

;;*****修改文字上下划线******黄明儒2013年12月18日
(defun C:uo (/ EN PT PTT STR X)
  ;;[功能]pt是在text上部，返回T
  (defun HH:TextSX (e en pt / H PT1)
    (setq h (cdr (assoc 40 en)))
    (setq pt1 (trans pt 1 0))
    (vl-cmdf "_.ucs" "OB" e)        ;转到对象坐标系
    (setq pt1 (trans pt1 0 1))        ;当前ucs
    (vl-cmdf "_.ucs" "_p")        ;恢复ucs   
    (< (/ h 2.0) (cadr pt1))
  )
  ;;Flag,nil 右击，删除上下划线
  (defun leftPick (e pt Flag / EN STR)
    (set 'en (entget e))
    (setq str (cdr (assoc 1 en)))
    (mapcar '(lambda (x) (setq str (vl-string-trim x str)))
     (list "%%O" "%%o" "%%U" "%%u")
    )
    (if Flag
      (if (HH:TextSX e en pt)
(entmod (subst (cons 1 (strcat "%%o" str)) (assoc 1 en) en))
(entmod (subst (cons 1 (strcat "%%u" str)) (assoc 1 en) en))
      )
      (entmod (subst (cons 1 str) (assoc 1 en) en))
    )
  )
  ;; 本程序主程序
  (vl-load-com)
  (HH:ayOSMode nil)
  (princ "\n 修改文字上下划线(左击:上下划线; 右击:删除)")
  (while
    (cond ((and (setq pt (grread t 4 2))      ;获取grread值
  (equal (car pt) 5)
    )
    (progn
      (setq ptt (cadr pt)
     en  (nentselp ptt)
      )
      t
    )
   )
   ((and (equal (car pt) 3) en (ssget (cadr en) '((0 . "TEXT")))) ;3为左键
    (leftPick (car en) (cadr en) T)
   )
   ((and (or (equal (car pt) 11) (equal (car pt) 25))
  en
  (ssget (cadr en) '((0 . "TEXT")))
    )          ;右键
    (leftPick (car en) (cadr en) nil)
   )
    )
  )
  (HH:ayOSMode T)
  (gc)
  (princ)
)
;;*****修改文字上下划线******黄明儒2013年12月18日
;;本程序是想说明，可以将文字划分成网格，touch不同的地方产生不同的反应，从而显得"文本"生机勃勃,同现实比较接近。好多对象均可这样处理。

自贡黄明儒

hw8810 发表于 2021-1-29 17:41
缺函数啊大佬no function definition: HH:AYOSMODE

就是按下F3，注释掉就行，影响不大

hw8810

自贡黄明儒 发表于 2021-1-29 21:02
就是按下F3，注释掉就行，影响不大

谢谢大佬，学习了

hw8810

缺函数啊大佬no function definition: HH:AYOSMODE

819534890

不错，有点意思

hao3ren

黄总好无聊啊

hao3ren

是不可以点左右，将文字放在框里面啊
我晕原来是u%%

自贡黄明儒

hao3ren 发表于 2013-12-18 15:46
是不可以点左右，将文字放在框里面啊
我晕原来是u%%

如果再划分左右，击文字可以执行许多程序了

ynhh

黄总的新产品真多啊

spp_wall

量产啊！！！！！！

bai2000

有点意思啊

tianyi1230

挺好玩的，想法独特

ysq101

黄大师果然高产啊~~~~~~支持一个~~~~
能不能帮我写一个这样的程序啊？？先谢谢了
http://bbs.xdcad.net/thread-672075-1-1.html