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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 程序（函数）库 › LISP/VLISP程序库 › 把文字加删除线[分享]
返回列表 发新帖
查看: 2184|回复: 12

把文字加删除线[分享]

[复制链接]
LUCAS
发表于 2002-1-24 20:07:54 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×

  3. ;;;把文字加删除线
  4. ;;;程序设计:赖云龙;;;
  5. ;;;---------------;;;
  6. (defun C:MT  (/             HOLDOSMODE           HOLDCLAYER         SS        TEXTM  TEXTM1
  7.               M10    M40    M42           M43          M50         M71        PT1    PT2
  8.               PT3    PT4    PT5           PT6          PT7         PT8        PT9    RT
  9.               TB     DIST   DIST1  D          ANG
  10.              )
  11.   (command "_.UNDO" "BE")
  12.   (setq HOLDOSMODE (getvar "OSMODE"))
  13.   (setq HOLDCLAYER (getvar "CLAYER"))
  14.   (setvar "OSMODE" 0)
  15.   (if (= (tblsearch "LAYER" "DIM") NIL)
  16.     (command "_.layer" "m"         "dim"           "c"             "cyan"
  17.              ""               "lt"         "continuous"             ""
  18.              ""
  19.             )
  20.   )
  21.   (setvar "CLAYER" HOLDCLAYER)
  22.   (setq TEXTM1 (car (nentsel)))
  23.   (setq TEXTM (entget TEXTM1))
  24.   (cond
  25.     ((= "MTEXT" (cdr (assoc 0 TEXTM)))
  26.      (command "_.ucs" "W")
  27.      (setq M10 (cdr (assoc 10 TEXTM)))
  28.      (setq M40 (cdr (assoc 40 TEXTM)))
  29.      (setq M42 (cdr (assoc 42 TEXTM)))
  30.      (setq M43 (cdr (assoc 43 TEXTM)))
  31.      (setq M50 (cdr (assoc 50 TEXTM)))
  32.      (setq M71 (cdr (assoc 71 TEXTM)))
  33.      (setq PT9 (list (+ (car M10) M42) (cadr M10) (caddr M10)))
  34.      (setq PT3 (list (car PT9) (+ (cadr PT9) M43) (caddr PT9)))
  35.      (setq PT1 (list (car M10) (+ (cadr M10) M43) (caddr M10)))
  36.      (setq PT8 (list (+ (car M10) (/ M42 2)) (cadr M10) (caddr M10)))
  37.      (setq PT4 (list (car M10) (+ (cadr M10) (/ M43 2)) (caddr M10)))
  38.      (setq PT2 (list (+ (car M10) (/ M42 2))
  39.                      (+ (cadr M10) M43)
  40.                      (caddr M10)
  41.                )
  42.      )
  43.      (setq PT6 (list (+ (car M10) M42)
  44.                      (+ (cadr M10) (/ M43 2))
  45.                      (caddr M10)
  46.                )
  47.      )
  48.      (setq SS (ssadd))
  49.      (setq ANG (angle M10 PT1))
  50.      (setq M101 (polar M10 ANG (/ M40 3.0)))
  51.      (setq PT91 (polar PT9 ANG (/ M40 3.0)))
  52.      (command "_.LINE" M101 PT91 "")
  53.      (ssadd (entlast) SS)
  54.      (setq SS1 (entlast))
  55.      (command "_.OFFSET" (/ M40 3.0) (entlast) M101 "")
  56.      (ssadd (entlast) SS)
  57.      (setq PT5 (inters M10 PT3 PT9 PT1))
  58.      (cond
  59.        ((= 1 M71) (command "._move" SS "" PT1 M10)) ;1 = Top left
  60.        ((= 2 M71) (command "._move" SS "" PT2 M10)) ;2 = Top center
  61.        ((= 3 M71) (command "._move" SS "" PT3 M10)) ;3 = Top right
  62.        ((= 4 M71) (command "._move" SS "" PT4 M10)) ;4 = Middle left
  63.        ((= 5 M71) (command "._move" SS "" PT5 M10)) ;5 = Middle center
  64.        ((= 6 M71) (command "._move" SS "" PT6 M10)) ;6 = Middle right
  65. ;;;    ((= 7 M71) (command "._move" SS "" M10 M10)) ;7 = Bottom left
  66.        ((= 8 M71) (command "._move" SS "" PT8 M10)) ;8 = Bottom center
  67.        ((= 9 M71) (command "._move" SS "" PT9 M10)) ;9 = Bottom right
  68.      )
  69.      (command "_.ROTATE" SS "" M10 (/ (* 180 M50) pi))
  70.      (command "_.CHANGE" SS "" "P" "LA" "DIM" "C" 6 "")
  71.      (setq DIST (* M40 1.66))
  72.      (setq DIST1 (fix (/ M43 DIST)))
  73.      (setq D 1)
  74.      (repeat DIST1
  75.        (command        "_.COPY"
  76.                 SS
  77.                 ""
  78.                 M10
  79.                 (polar M10 (+ M50 (/ pi 2)) (* DIST D))
  80.        )
  81.        (setq D (+ 1 D))
  82.      )
  83.      (command "_.ucs" "p")
  84.     )
  85.     ((= "TEXT" (cdr (assoc 0 TEXTM)))
  86.      (command "_.ucs" "Object" TEXTM1)
  87.      (setq TB (textbox (list (cons -1 TEXTM1))))
  88.      (setq PT1 (car TB)
  89.            PT2 (cadr TB)
  90.            PT3 (list (car PT1) (cadr PT2))
  91.            PT4 (list (car PT2) (cadr PT1))
  92.      )
  93.      (setq DIST (/ (distance PT1 PT3) 3.0))
  94.      (setq ANG (angle PT1 PT3))
  95.      (setq SS (ssadd))
  96.      (command "_.LINE" PT1 PT4 "")
  97.      (ssadd (entlast) SS)
  98.      (command "_.MOVE"
  99.               (entlast)
  100.               ""
  101.               "0,0"
  102.               (polar '(0 0) ANG DIST)
  103.      )
  104.      (command "_.OFFSET" DIST (entlast) PT3 "")
  105.      (ssadd (entlast) SS)
  106.      (command "_.CHANGE" SS "" "P" "LA" "DIM" "C" 6 "")
  107.      (command "_.ucs" "p")
  108.     )
  109.   )
  110.   (setvar "OSMODE" HOLDOSMODE)
  111.   (command "_.UNDO" "END")
  112.   (princ)
  113. )
command, setq

相关帖子

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

使用道具 举报

前生

已领礼包: 8个

财富等级: 恭喜发财
发表于 2002-1-26 09:50:07 | 显示全部楼层
;;;

  3. (Defun c:ourwjc1        (/     count lyx   doc         ben   handles           l1         l2
  4.                  lyx   lyy   count x1         x2    y1    y2           ELI         pp
  5.                  ent
  6.                 )
  7.   (setq pp nil)
  8.   (setq count 0)
  9.   (setq lyx nil)
  10.   (setq lyy nil)
  11.   (vl-load-com)
  12.   (SetQ doc (VLA-Get-ActiveDocument (VLAX-Get-ACAD-Object)))
  13.   (prompt "\n 请选择实体:..")
  14.   (setq ben (ssget))
  15.   (if ben
  16.     (progn
  17.       (while (< count (sslength ben))
  18.         (setq ent (ssname ben count))
  19.         (SetQ
  20.           handles
  21.            (Cdr (Assoc 5 (EntGet ent)))
  22.         )
  23.         (VLA-GetBoundingBox
  24.           (VLA-HandleToObject doc handles)
  25.           'llp
  26.           'urp
  27.         )
  28.         (setq l1 (VLAX-SafeArray->List llp))
  29.         (setq lyx (cons (Car l1) lyx))
  30.         (setq lyy (cons (Cadr l1) lyy))
  31.         (setq l2 (VLAX-SafeArray->List urp))
  32.         (setq lyx (cons (Car l2) lyx))
  33.         (setq lyy (cons (Cadr l2) lyy))
  34.         (setq count (1+ count))
  35.       )
  36.       (setq lyx (vl-sort lyx '<))
  37.       (setq lyy (vl-sort lyy '<))
  38.       (setq x1 (nth 0 lyx)
  39.             x2 (last lyx)
  40.       )
  41.       (setq y1 (nth 0 lyy)
  42.             y2 (last lyy)
  43.       )
  44. ;;;      (setq p1 (list x1 y2)
  45. ;;;            p2 (list x1 y1)
  46. ;;;      )
  47. ;;;      (setq eli        (list (cons 0 "LINE")
  48. ;;;                      (cons 8 "外框")
  49. ;;;                      (cons 10 P1)
  50. ;;;                      (cons 11 P2)
  51. ;;;                )
  52. ;;;      )
  53. ;;;      (entmake eli)
  54. ;;;      (setq p1 (list x2 y1))
  55. ;;;      (setq eli        (list (cons 0 "LINE")
  56. ;;;                      (cons 8 "外框")
  57. ;;;                      (cons 10 P1)
  58. ;;;                      (cons 11 P2)
  59. ;;;                )
  60. ;;;      )
  61. ;;;      (entmake eli)
  62. ;;;      (setq p2 (list x2 y2))
  63. ;;;      (setq eli        (list (cons 0 "LINE")
  64. ;;;                      (cons 8 "外框")
  65. ;;;                      (cons 10 P1)
  66. ;;;                      (cons 11 P2)
  67. ;;;                )
  68. ;;;      )
  69. ;;;      (entmake eli)
  70. ;;;      (setq p1 (list x1 y2))
  71. ;;;      (setq eli        (list (cons 0 "LINE")
  72. ;;;                      (cons 8 "外框")
  73. ;;;                      (cons 10 P1)
  74. ;;;                      (cons 11 P2)
  75. ;;;                )
  76. ;;;      )
  77. ;;;      (entmake eli)
  78. ;;;      (setq p1 nil
  79. ;;;            p2 nil
  80. ;;;      )
  81.       (setq p1 (list x1 y1)
  82.             p2 (list x2 y2)
  83.       )
  84.       (setlay "取消" 2 "HIDDEN")
  85.       (setq eli        (list (cons 0 "LINE")
  86.                       (cons 8 "取消")
  87.                       (cons 10 P1)
  88.                       (cons 11 P2)
  89.                 )
  90.       )
  91.       (entmake eli)
  92.       (setq p1 (list x1 Y2)
  93.             p2 (list x2 y1)
  94.       )
  95.       (setq eli        (list (cons 0 "LINE")
  96.                       (cons 8 "取消")
  97.                       (cons 10 P1)
  98.                       (cons 11 P2)
  99.                 )
  100.       )
  101.       (entmake eli)
  102.     )
  103.                                         ;progn
  104.     (prompt "\n 未选取到实体:..")
  105.   )
  106.   (SETQ        BEN NIL
  107.         ent nil
  108.         handles        nil
  109.         llp nil
  110.         urp nil
  111.         l1 nil
  112.         lyx nil
  113.         lyy nil
  114.         l2 nil
  115.         x1 nil
  116.         x2 nil
  117.         y1 nil
  118.         y2 nil
  119.         l nil
  120.         pp nil
  121.         ls nil
  122.         p1 nil
  123.         p2 nil
  124.         eli nil
  125.   )
  126.   (princ)
  127. )
  128. ;;;
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

前生

已领礼包: 8个

财富等级: 恭喜发财
发表于 2002-1-26 11:16:35 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
呵呵,文字.实体都可以
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

li809
发表于 2005-2-18 09:23:27 | 显示全部楼层
修改图的时候可以用到，很直观反映修改前后的情况
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

caibaobao
发表于 2005-6-11 10:26:49 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
上面两个，用哪一个？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zxcvbnm-cad
发表于 2005-6-15 11:23:57 | 显示全部楼层
呵呵,文字.实体都可以

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

使用道具 举报

海豚
发表于 2005-7-3 22:55:57 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
第一个程序只对文字有效，第二个对各种实体都有效，但是我也出现了“no function definition: SETLAY ”的问题，我干脆把SETLAY这句取消就可以了，不知道这句的作用时什么。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

地鼠
发表于 2005-11-13 23:36:41 | 显示全部楼层
好东西。已收藏
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

jeson0113
发表于 2005-12-18 11:51:18 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
　我也做一下，很好的东西哦！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

jiega
发表于 2005-12-18 11:58:13 | 显示全部楼层
可以给文字（单行文本）加单下划线、双下划线、双删除线和矩形外框
http://www.xdcad.net/forum/showthread.php?s=&threadid=498681
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

liujian166
发表于 2006-8-22 15:30:57 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
好像用处不是很大啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zlzlzlzl
发表于 2007-5-1 19:44:06 | 显示全部楼层
实体可以？怎么不行？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

gmglass
发表于 2007-5-28 09:26:05 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
直接画不好吗？？？？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-17 23:31 , Processed in 0.206884 second(s), 53 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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