设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 字符下划线随字符长短变化
12下一页
返回列表 发新帖
查看: 779|回复: 13

[讨论] 字符下划线随字符长短变化

[复制链接]
帝都划水王
发表于 2024-1-17 17:22 | 显示全部楼层 |阅读模式


字符下划线随着字符修改的长短变化而变化，始终比字符两段长100，如何实现
回复

使用道具 举报

e2002
发表于 2024-1-19 09:13 | 显示全部楼层
本帖最后由 e2002 于 2024-1-19 09:14 编辑

实际工作中，还是关注设计本身吧，不需要纠结这种细微末节。

毕竟一张要打印的图纸上，除了大样图这种，其他基本上涉及到图名的位置不超过5处，你就手动改一下也不需要多少时间。

有这个精力，不如用在画图的符合企业规范、绘制中的精确度，标注与说明文字的的准确性上。
回复 支持 1 反对 0

使用道具 举报

尘缘一生
发表于 2024-1-18 08:33 | 显示全部楼层



三领强大的综合修剪之中，一小功能罢了。

本帖子中包含更多资源

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

x
回复 支持 1 反对 0

使用道具 举报

x_s_s_1
发表于 2024-1-18 11:03 | 显示全部楼层
胡编乱造小bug版

  1. (vl-load-com)
  2. (if (not *bl*)
  3.     (setq *bl* "1:100"))
  4. (if (or  (= (getvar "userr1") "")
  5.   (= (equal (getvar "userr1") 0)))
  6.     (setvar "userr1" 100))
  7. (defun ly_mak  (l_p l_l l_c l_s l_n /)
  8.     (if  (= (tblobjname "LAYER" l_n) nil)
  9.   (progn (entmake  (list (cons 0 "LAYER")
  10.             (cons 100 "AcDbSymbolTableRecord")
  11.             (cons 100 "AcDbLayerTableRecord")
  12.             (if l_p
  13.           (cons 290 l_p)
  14.           '(290 . 1))
  15.             (if l_l
  16.           (cons 6 l_l)
  17.           '(6 . "CONTINUOUS"))
  18.             (if l_c
  19.           (cons 62 l_c)
  20.           '(62 . 7))
  21.             (if l_s
  22.           (cons 70 l_s)
  23.           '(70 . 0))
  24.             (cons 2 l_n))))))
  25. (defun t_mak  (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)
  26.     (entmake (list '(0 . "text")
  27.        '(100 . "AcDbEntity")
  28.        (cons 8 l_n)
  29.        '(100 . "AcDbText")
  30.        (cons 10 t_10)
  31.        (cons 1 t_t)
  32.        (cons 40 t_h)
  33.        (cons 41 t_w)
  34.        (cons 7 t_st)
  35.        (cons 72 t_72)
  36.        (cons 11 t_11)
  37.        (cons 50 t_50)
  38.        (cons 73 t_73))))
  39. (defun pl_mak  (lst l_n w / x)
  40.     (entmake (append (list '(0 . "LWPOLYLINE")
  41.          '(100 . "AcDbEntity")
  42.          '(100 . "AcDbPolyline")
  43.          (cons 8 l_n)
  44.          (cons 90 (length lst))
  45.          (cons 43 w))
  46.          (mapcar '(lambda (x) (cons 10 x)) lst))))
  47. (defun del_z  (pt /)
  48.     (reverse (cdr (reverse pt))))
  49. (defun x_text_by_line_change  (change-obj     reactor-obj
  50.              parameter-list     /       pt1
  51.              tm_txt   sc     txt_obj   ptl
  52.              pta   ptb     ptc       pl_obj
  53.              lst   oldlst     i       x
  54.              bl_obj)
  55.     (if  (setq txt_obj (vlax-vla-object->ename change-obj))
  56.   (progn
  57.       (setq pl_obj (handent (car (vlr-data reactor-obj))))
  58.       (setq bl_obj (handent (cadr (vlr-data reactor-obj))))
  59.       (setq sc (getvar "userr1"))
  60.       (setq ptl (textbox (entget txt_obj)))
  61.       (setq pt1 (cdr (assoc 11 (entget txt_obj))))
  62.       (setq ptl (mapcar '- (cadr ptl) (car ptl)))
  63.       (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))
  64.       (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))
  65.       (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))
  66.       (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))
  67.       (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))
  68.       (setq ptl (mapcar '(lambda (x) (cons 10 (del_z x)))
  69.             (list pta ptb)))
  70.       (setq lst (entget pl_obj))
  71.       (setq oldlst
  72.          (apply 'append
  73.           (mapcar '(lambda (x)
  74.            (if (= 10 (car x))
  75.                (list x)))
  76.             lst)))
  77.       (setq i 0)
  78.       (repeat (length ptl)
  79.     (setq lst (subst (nth i ptl) (nth i oldlst) lst))
  80.     (setq i (1+ i)))
  81.       (entmod lst)
  82.       (setq lst (entget bl_obj))
  83.       (setq lst (subst (cons 10 ptc) (assoc 10 lst) lst))
  84.       (entmod lst))))
  85. (DEFUN creat_objreactor   (obj obj_lst /)
  86.     (vlr-pers (vlr-object-reactor
  87.       obj
  88.       obj_lst
  89.       '((:vlr-modified . x_text_by_line_change)
  90.         (:vlr-copied . x_text_by_line_copied)
  91.         (:VLR-ERASED . AR_AE_RR_ERASED)))))
  92. (DEFUN x_text_by_line_copied
  93.        (NOTIFIER-OBJECT REACTOR-OBJECT PARAMETER-LIST / ENT)
  94.     (IF  (/= (CAR PARAMETER-LIST) 0)
  95.   (SETQ ENT      (CAR PARAMETER-LIST)
  96.         *REACTORCOPY* (CONS ENT *REACTORCOPY*))))
  97. (DEFUN CMD-START  (REACTOR COMMAND-LIST /)
  98.     (SETQ *REACTORCOPY* NIL)
  99.     (PRINC))
  100. (DEFUN CMD-ENDED  (REACTOR  COMMAND-LIST      /         ent
  101.        txt_obj  ptl       pt1      pta      ptb
  102.        ptc      sc       pl_obj   bl_obj)
  103.     (IF  *REACTORCOPY*
  104.   (FOREACH ent  *REACTORCOPY*
  105.       (SETQ txt_obj (cons (VLAX-ENAME->VLA-OBJECT ent) nil))
  106.       (setq sc (getvar "userr1"))
  107.       (setq ptl (textbox (entget ent)))
  108.       (setq pt1 (cdr (assoc 11 (entget ent))))
  109.       (setq ptl (mapcar '- (cadr ptl) (car ptl)))
  110.       (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))
  111.       (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))
  112.       (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))
  113.       (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))
  114.       (setq ptl (list pta ptb))
  115.       (pl_mak ptl "图名" (* 0.5 sc))
  116.       (setq pl_obj (cdr (assoc 5 (entget (entlast)))))
  117.       (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))
  118.       (t_mak "图名"
  119.        ptc
  120.        ptc
  121.        *bl*
  122.        0
  123.        0
  124.        0
  125.        (* 4 sc)
  126.        0.75
  127.        "standard")
  128.       (setq bl_obj (cdr (assoc 5 (entget (entlast)))))
  129.       (creat_objreactor txt_obj (list pl_obj bl_obj))))
  130.     (SETQ *REACTORCOPY* NIL)
  131.     (PRINC))
  132. (DEFUN AR_AE_RR_ERASED
  133.        (NOTIFIER-OBJECT REACTOR-OBJECT PARAMETER-LIST / I)
  134.     (FOREACH I  (CDR (CAR (VLR-REACTORS :VLR-OBJECT-REACTOR)))
  135.   (IF (VLAX-ERASED-P (CAR (VLR-OWNERS I)))
  136.       (PROGN (VLR-PERS-RELEASE I) (VLR-REMOVE I)))))
  137. (defun c:xx  (/  pt1 tm_txt sc txt_obj ptl pta ptb ptc pl_obj x_vlr
  138.         bl_obj scc)
  139.     (ly_mak 1 "continuous" 7 0 "图名")
  140.     (setq pt1   (getpoint "\n请输入图名插入点：")
  141.     tm_txt (getstring "\n请输入图名：")
  142.     sc   (getvar "userr1"))
  143.     (setq scc (getstring "\n请输入比例：(1:?) <100>"))
  144.     (IF  (= scc "")
  145.   (SETQ scc "100"))
  146.     (setq *bl* (strcat "1:" scc))
  147.     (t_mak "图名"
  148.      '(0 0 0)
  149.      pt1
  150.      tm_txt
  151.      0
  152.      1
  153.      0
  154.      (* 7 sc)
  155.      0.75
  156.      "standard")
  157.     (setq txt_obj (cons (vlax-ename->vla-object (entlast)) nil))
  158.     (setq ptl (textbox (entget (entlast))))
  159.     (setq ptl (mapcar '- (cadr ptl) (car ptl)))
  160.     (setq pta (polar pt1 pi (+ (/ (car ptl) 2) (* 1.5 sc))))
  161.     (setq pta (polar pta (* 1.5 pi) (* 1.5 sc)))
  162.     (setq ptb (polar pt1 0 (+ (/ (car ptl) 2) (* 1.5 sc))))
  163.     (setq ptb (polar ptb (* 1.5 pi) (* 1.5 sc)))
  164.     (setq ptl (list pta ptb))
  165.     (pl_mak ptl "图名" (* 0.5 sc))
  166.     (setq pl_obj (cdr (assoc 5 (entget (entlast)))))
  167.     (setq ptc (polar (polar ptb (* 0.5 pi) (* 1.5 sc)) 0 sc))
  168.     (t_mak "图名" ptc ptc *bl* 0 0 0 (* 4 sc) 0.75 "standard")
  169.     (setq bl_obj (cdr (assoc 5 (entget (entlast)))))
  170.     (creat_objreactor txt_obj (list pl_obj bl_obj))
  171.     (IF  (NOT *COMMANDREACTOR*)
  172.   (SETQ *COMMANDREACTOR*
  173.      (VLR-PERS (VLR-COMMAND-REACTOR
  174.              NIL
  175.              '((:VLR-COMMANDWILLSTART
  176.           .
  177.           CMD-START)
  178.          (:VLR-COMMANDENDED
  179.           .
  180.           CMD-ENDED)))))))



本帖子中包含更多资源

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

x
回复 支持 1 反对 0

使用道具 举报

xyp1964
发表于 2024-1-17 22:26 | 显示全部楼层

本帖子中包含更多资源

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

x
回复 支持 1 反对 0

使用道具 举报

帝都划水王
 楼主| 发表于 2024-1-17 17:23 | 显示全部楼层
如下图截图

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

烟盒迷唇
发表于 2024-1-17 19:12 | 显示全部楼层
求出包围盒，然后外扩，取得两点坐标画线
回复 支持 反对

使用道具 举报

wangsr
发表于 2024-1-18 08:19 | 显示全部楼层
xyp1964 发表于 2024-1-17 22:26

不错，怎么实现的？
回复 支持 反对

使用道具 举报

llsheng_73
发表于 2024-1-18 08:51 | 显示全部楼层
直接给字符加%%U不行么？
回复 支持 反对

使用道具 举报

帝都划水王
 楼主| 发表于 2024-1-18 09:35 | 显示全部楼层
xyp1964 发表于 2024-1-17 22:26

很强，是预想的效果
回复 支持 反对

使用道具 举报

帝都划水王
 楼主| 发表于 2024-1-18 15:10 | 显示全部楼层
x_s_s_1 发表于 2024-1-18 11:03
胡编乱造小bug版

把那个比例删了就差不多了，可以的
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-5-7 07:14 , Processed in 0.553943 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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