设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃资源交流 › 技术问答【悬赏求助】 › 修改标注为垂直标注
返回列表 发新帖
查看: 3158|回复: 11

[求助] 修改标注为垂直标注

[复制链接]
f4800

已领礼包: 1个

财富等级: 恭喜发财
发表于 2021-4-13 08:41:47 | 显示全部楼层 |阅读模式
悬赏20D豆已解决

大佬们  这段源码标注的文字是水平的  怎么修改为增加可选项 ，有水平或垂直标注的选择？  多谢了

20210413084115.png



  • (defun c:zbbz (/ LC:TEXTLENGTH TEXTSTYLE-BAK TEXTSIZE-BAK TEXTHIGH XSWS PT1 PT2 STRLST TEXTLENGTH PT3 LST)
  •   (defun LC:TextLength (String / Tbox)
  •     (setq Tbox (textbox (list (cons 1 String))))
  •     (distance (car Tbox) (cadr Tbox))
  •   )
  •   (setq TEXTSTYLE-bak(getvar "TEXTSTYLE"))
  •   (setvar "TEXTSTYLE" "Standard")
  •   (setq textsize-bak (Getvar "textsize")) ;字高系统变量
  •   (setq texthigh (getreal "\n  请输入文字高度<1.5>: "))
  •   (if (null texthigh) (setq texthigh 1.5))
  •   (Setvar "textsize" texthigh)
  •   (setq xsws (getint "\n 请输入小数位数<3>: "))
  •   (if (null xsws) (setq xsws 3))
  •   (while (setq pt1 (getpoint "\n 指定注记点: "))
  •     (setq pt2 (getpoint "注记位置: "))  
  •     (setq strlst (mapcar'strcat'("Y= " "X= " "H= ")(mapcar '(lambda (x) (rtos x 2 xsws)) pt1)))
  •     (setq textlength (apply 'MAX (mapcar '(lambda (x) (LC:TextLength x)) strlst)));文字最大长度
  •     (setq pt3 (if (> (car pt2) (car pt1))
  •                   (polar pt2 0 (+ textlength 1))
  •                   (polar pt2 pi (+ textlength 1))
  •               )
  •     )
  •     (setq lst (list pt1 pt2 pt3))
  •     (entmake (list '(0 . "TEXT")'(41 . 1.0)(cons 1 (cadr strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 0.5 pi) (* texthigh 0.2))) (cons 40 texthigh)))
  •     (entmake (list '(0 . "TEXT")'(41 . 1.0) (cons 1 (car strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (+ (* texthigh 0.2) texthigh))) (cons 40 texthigh)))
  •     (entmake (list '(0 . "TEXT") '(41 . 1.0)(cons 1 (last strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (+ (* texthigh 0.4) (* texthigh 2.0)))) (cons 40 texthigh)))
  •     (entmake (append (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90 (length lst)))(mapcar '(lambda (pt) (cons 10 pt)) lst)))
  •   )
  •   (Setvar "textsize" textsize-bak) ;还原字高系统变量
  •   (setvar "TEXTSTYLE" TEXTSTYLE-bak) ;还原字体系统变量
  • )

最佳答案

叮LSP咚

查看完整内容

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

叮LSP咚

已领礼包: 23个

财富等级: 恭喜发财
发表于 2021-4-13 08:41:48 | 显示全部楼层
  1. (defun c:zbbz (/ LC:TEXTLENGTH TEXTSTYLE-BAK TEXTSIZE-BAK TEXTHIGH XSWS PT1 PT2 STRLST TEXTLENGTH PT3 LST)
  2.   (defun LC:TextLength (String / Tbox)
  3.     (setq Tbox (textbox (list (cons 1 String))))
  4.     (distance (car Tbox) (cadr Tbox))
  5.   )
  6.   (setq TEXTSTYLE-bak(getvar "TEXTSTYLE"))
  7.   (setvar "TEXTSTYLE" "Standard")
  8.   (setq textsize-bak (Getvar "textsize")) ;字高系统变量
  9.   (setq texthigh (getreal "\n  请输入文字高度<1.5>: "))
  10.   (if (null texthigh) (setq texthigh 1.5))
  11.   (Setvar "textsize" texthigh)
  12.   (setq xsws (getint "\n 请输入小数位数<3>: "))
  13.   (if (null xsws) (setq xsws 3))
  14.   (initget "H V  ")
  15.   (setq fxx (getkword "\n指定标记方向[H/V]<H>:"))
  16.   (or fxx (setq fxx "H"))
  17.   (while (setq pt1 (getpoint "\n 指定注记点: "))
  18.     (setq pt2 (getpoint pt1 "注记位置: "))  
  19.     (setq strlst (mapcar'strcat'("Y= " "X= " "H= ")(mapcar '(lambda (x) (rtos x 2 xsws)) pt1)))
  20.     (setq textlength (apply 'MAX (mapcar '(lambda (x) (LC:TextLength x)) strlst)));文字最大长度
  21.     (if (= fxx "H")
  22.       (progn
  23.         (setq pt3 (if (> (car pt2) (car pt1))
  24.                       (polar pt2 0 (+ textlength 1))
  25.                       (polar pt2 pi (+ textlength 1))
  26.                   )
  27.         )
  28.         (setq lst (list pt1 pt2 pt3))
  29.         (entmake (list '(0 . "TEXT")'(41 . 1.0)(cons 1 (cadr strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 0.5 pi) (* texthigh 0.2))) (cons 40 texthigh)))
  30.         (entmake (list '(0 . "TEXT")'(41 . 1.0) (cons 1 (car strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (+ (* texthigh 0.2) texthigh))) (cons 40 texthigh)))
  31.         (entmake (list '(0 . "TEXT") '(41 . 1.0)(cons 1 (last strlst)) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (+ (* texthigh 0.4) (* texthigh 2.0)))) (cons 40 texthigh)))
  32.         (entmake (append (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90 (length lst)))(mapcar '(lambda (pt) (cons 10 pt)) lst)))
  33.       )
  34.       (progn
  35.         (setq pt3 (if (> (cadr pt2) (cadr pt1))
  36.                       (polar pt2 (* 0.5 pi) (+ textlength 1))
  37.                       (polar pt2 (* -0.5 pi) (+ textlength 1))
  38.                   )
  39.         )
  40.         (setq lst (list pt1 pt2 pt3))
  41.         (entmake (list '(0 . "TEXT")'(41 . 1.0)(cons 1 (cadr strlst)) (cons 10 (polar (polar (IF (>= (cadr pt2) (cadr pt1)) pt2 pt3) (* 0.5 pi) 0.5) pi (* texthigh 0.2))) (cons 40 texthigh)(cons 50 (* 0.5 pi))))
  42.         (entmake (list '(0 . "TEXT")'(41 . 1.0) (cons 1 (car strlst)) (cons 10 (polar (polar (IF (>= (cadr pt2) (cadr pt1)) pt2 pt3) (* 0.5 pi) 0.5) 0  (+ (* texthigh 0.2) texthigh))) (cons 40 texthigh)(cons 50 (* 0.5 pi))))
  43.         (entmake (list '(0 . "TEXT") '(41 . 1.0)(cons 1 (last strlst)) (cons 10 (polar (polar (IF (>= (cadr pt2) (cadr pt1)) pt2 pt3) (* 0.5 pi) 0.5) 0 (+ (* texthigh 0.4) (* texthigh 2.0)))) (cons 40 texthigh)(cons 50 (* 0.5 pi))))
  44.         (entmake (append (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90 (length lst)))(mapcar '(lambda (pt) (cons 10 pt)) lst)))
  45.       )
  46.     )
  47.   )
  48.   (Setvar "textsize" textsize-bak) ;还原字高系统变量
  49.   (setvar "TEXTSTYLE" TEXTSTYLE-bak) ;还原字体系统变量
  50.   (princ)
  51. )

点评

f4800
大师 继续追问下。。。 现在已经实现了垂直标注，假如，假如现在我想在X Y坐标之前分别添加一组汉字，该如何实现？ 见图片，汉字是独立的， 与X Y 不是一个单行文字。在希望调整文字大小的同时，汉字大小也跟着  详情 回复 发表于 2021-4-15 21:16
f4800
大师 感谢 感谢 感谢  详情 回复 发表于 2021-4-14 11:35

评分

参与人数 1D豆 +5 收起 理由
f4800 + 5 很给力!技术大牛；热心人。。感谢

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

weizx2000

已领礼包: 110个

财富等级: 日进斗金
发表于 2021-4-14 00:02:04 | 显示全部楼层
谢谢分享谢谢分享
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

f4800

已领礼包: 1个

财富等级: 恭喜发财
 楼主| 发表于 2021-4-14 11:35:12 | 显示全部楼层
叮LSP咚 发表于 2021-4-14 09:08

大师  感谢 感谢  感谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

f4800

已领礼包: 1个

财富等级: 恭喜发财
 楼主| 发表于 2021-4-15 21:16:26 | 显示全部楼层
叮LSP咚 发表于 2021-4-13 08:41

大师 继续追问下。。。
现在已经实现了垂直标注，假如，假如现在我想在X Y坐标之前分别添加一组汉字，该如何实现？

见图片，汉字是独立的， 与X Y 不是一个单行文字。在希望调整文字大小的同时，汉字大小也跟着变化

多谢大师  多谢  再次感谢

TIM图片20210415211328.png



点评

叮LSP咚
那不如改用多行字，也可以实现颜色不一样  详情 回复 发表于 2021-4-16 21:19
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

叮LSP咚

已领礼包: 23个

财富等级: 恭喜发财
发表于 2021-4-16 21:19:56 | 显示全部楼层
f4800 发表于 2021-4-15 21:16
大师 继续追问下。。。
现在已经实现了垂直标注，假如，假如现在我想在X Y坐标之前分别添加一组汉字，该 ...

那不如改用多行字，也可以实现颜色不一样

点评

f4800
大师 这样用多行 如何优化？？ 多谢了大师。。。。。。  详情 回复 发表于 2021-4-16 21:33
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

f4800

已领礼包: 1个

财富等级: 恭喜发财
 楼主| 发表于 2021-4-16 21:33:42 | 显示全部楼层
叮LSP咚 发表于 2021-4-16 21:19
那不如改用多行字，也可以实现颜色不一样

大师  这样用多行 如何优化？？  多谢了大师。。。。。。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

叮LSP咚

已领礼包: 23个

财富等级: 恭喜发财
发表于 2021-4-17 10:38:02 | 显示全部楼层
本帖最后由 叮LSP咚 于 2021-4-17 10:39 编辑

  1.    
  2. (defun c:zbbz (/ LC:TEXTLENGTH TEXTSTYLE-BAK TEXTSIZE-BAK TEXTHIGH XSWS PT1 PT2 STRLST TEXTLENGTH PT3 LST)
  3.   (defun LC:TextLength (String / Tbox)
  4.     (setq Tbox (textbox (list (cons 1 String))))
  5.     (distance (car Tbox) (cadr Tbox))
  6.   )
  7.   (setq TEXTSTYLE-bak(getvar "TEXTSTYLE"))
  8.   (setvar "TEXTSTYLE" "Standard")
  9.   (setq textsize-bak (Getvar "textsize")) ;字高系统变量
  10.   (setq texthigh (getreal "\n  请输入文字高度<1.5>: "))
  11.   (if (null texthigh) (setq texthigh 1.5))
  12.   (Setvar "textsize" texthigh)
  13.   (setq xsws (getint "\n 请输入小数位数<3>: "))
  14.   (if (null xsws) (setq xsws 3))
  15.   (initget "H V  ")
  16.   (setq fxx (getkword "\n指定标记方向[H/V]<H>:"))
  17.   (or fxx (setq fxx "H"))
  18.   (setq xstr (getstring t "\n输入X的前缀文字:"))
  19.   (setq ystr (getstring t "\n输入Y的前缀文字:"))
  20.   (while (setq pt1 (getpoint "\n 指定注记点: "))
  21.     (setq pt2 (getpoint pt1 "注记位置: "))  
  22.     (setq strlst (mapcar'strcat'("Y= " "X= ")(mapcar '(lambda (x) (rtos x 2 xsws)) (mapcar '+ pt1 '(0 0)))))
  23.     (setq textlength (apply 'MAX (mapcar '(lambda (x) (LC:TextLength x)) (mapcar '(lambda(e1 e2)(strcat e1 e2)) (list ystr xstr) strlst))));文字最大长度
  24.     (if (= fxx "H")
  25.       (progn
  26.         (setq pt3 (if (> (car pt2) (car pt1))
  27.                       (polar pt2 0 (+ textlength 1))
  28.                       (polar pt2 pi (+ textlength 1))
  29.                   )
  30.         )
  31.         (setq lst (list pt1 pt2 pt3))
  32.         (entmake (list '(0 . "MTEXT")'(100 . "AcDbEntity") '(100 . "AcDbMText")'(41 . 0)(cons 1 (strcat "\{\\C1;" xstr "\}" (cadr strlst))) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 0.5 pi) (* texthigh 1.5))) (cons 40 texthigh)))
  33.         (entmake (list '(0 . "MTEXT")'(100 . "AcDbEntity") '(100 . "AcDbMText")'(41 . 0) (cons 1 (strcat "\{\\C1;" ystr "\}" (car strlst))) (cons 10 (polar (polar (IF (>= (car pt2) (car pt1)) pt2 pt3) 0 0.5) (* 1.5 pi) (* texthigh 0.2))) (cons 40 texthigh)))
  34.         
  35.         (entmake (append (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90 (length lst)))(mapcar '(lambda (pt) (cons 10 pt)) lst)))
  36.       )
  37.       (progn
  38.         (setq pt3 (if (> (cadr pt2) (cadr pt1))
  39.                       (polar pt2 (* 0.5 pi) (+ textlength 1))
  40.                       (polar pt2 (* -0.5 pi) (+ textlength 1))
  41.                   )
  42.         )
  43.         (setq lst (list pt1 pt2 pt3))
  44.         (entmake (list '(0 . "MTEXT")'(100 . "AcDbEntity") '(100 . "AcDbMText")'(41 . 0)(cons 1 (strcat "\{\\C1;" xstr "\}" (cadr strlst))) (cons 10 (polar (polar (IF (>= (cadr pt2) (cadr pt1)) pt2 pt3) (* 0.5 pi) 0.5) pi (* texthigh 1.5))) (cons 40 texthigh)(cons 50 (* 0.5 pi))))
  45.         (entmake (list '(0 . "MTEXT")'(100 . "AcDbEntity") '(100 . "AcDbMText")'(41 . 0) (cons 1 (strcat "\{\\C1;" ystr "\}" (car strlst))) (cons 10 (polar (polar (IF (>= (cadr pt2) (cadr pt1)) pt2 pt3) (* 0.5 pi) 0.5) 0  (* texthigh 0.2))) (cons 40 texthigh)(cons 50 (* 0.5 pi))))
  46.         
  47.         (entmake (append (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")(cons 90 (length lst)))(mapcar '(lambda (pt) (cons 10 pt)) lst)))
  48.       )
  49.     )
  50.   )
  51.   (Setvar "textsize" textsize-bak) ;还原字高系统变量
  52.   (setvar "TEXTSTYLE" TEXTSTYLE-bak) ;还原字体系统变量
  53.   (princ)
  54. )


修改了

点评

f4800
大师 继续追问下。。多行文字能不能实现这种效果？？ 就是同一个多行文字中，字体样式、字体高度都不同？？ 多谢！再次感谢！！ [attachimg]104768[/attachimg]  详情 回复 发表于 2021-4-21 17:17
f4800
大师 太感谢你了。。。。。。。膜拜 再次感谢 再次感谢  详情 回复 发表于 2021-4-17 12:56

评分

参与人数 1D豆 +5 收起 理由
f4800 + 5 绝对的技术大牛、老师、好人！！感谢 感谢.

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

f4800

已领礼包: 1个

财富等级: 恭喜发财
 楼主| 发表于 2021-4-17 12:56:59 | 显示全部楼层
叮LSP咚 发表于 2021-4-17 10:38
修改了

大师   太感谢你了。。。。。。。膜拜   


再次感谢  再次感谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

f4800

已领礼包: 1个

财富等级: 恭喜发财
 楼主| 发表于 2021-4-21 17:17:40 | 显示全部楼层
叮LSP咚 发表于 2021-4-17 10:38
修改了

大师 继续追问下。。多行文字能不能实现这种效果？？
就是同一个多行文字中，字体样式、字体高度都不同？？
多谢！再次感谢！！

多行文字.png

点评

叮LSP咚
能，这个要你自己摸索。  详情 回复 发表于 2021-4-21 19:24
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

叮LSP咚

已领礼包: 23个

财富等级: 恭喜发财
发表于 2021-4-21 19:24:13 | 显示全部楼层
f4800 发表于 2021-4-21 17:17
大师 继续追问下。。多行文字能不能实现这种效果？？
就是同一个多行文字中，字体样式、字体高度都不同 ...

能，这个要你自己摸索。

点评

f4800
好的 多谢了 大师 多谢 多谢  详情 回复 发表于 2021-4-21 19:59

评分

参与人数 1D豆 +5 收起 理由
f4800 + 5 技术引导讨论和指点奖！

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

f4800

已领礼包: 1个

财富等级: 恭喜发财
 楼主| 发表于 2021-4-21 19:59:34 | 显示全部楼层
叮LSP咚 发表于 2021-4-21 19:24
能，这个要你自己摸索。

好的  多谢了  大师  多谢  多谢   
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-20 05:21 , Processed in 0.457855 second(s), 54 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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