乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 99|回复: 6

[编程交流] 单选更改为多-

[复制链接]

34

主题

174

帖子

60

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
257
发表于 2022-7-5 23:49:39 | 显示全部楼层 |阅读模式
下面的代码是修改文字高度,但只有单选对象
大家能帮我修改到多选吗?非常感谢。
 
  1. (defun EF:UNDOBegin ()
  2. (setvar "CMDECHO" 0 )
  3. (command "_.undo" "_group")
  4. (princ)
  5. ) ;end defun
  6. (defun EF:UNDOEnd()
  7. (setvar "CMDECHO" 0)
  8. (command "_.undo" "_end")
  9. (princ)
  10. ) ;end defun
  11. (defun c:tt( / dcl_id1 oba ob1 obn obt ptn otxt txt sty styno lay cyn layno hig wid ang col cnu etlst style layer)
  12. (graphscr)
  13. (EF:UNDOBegin)
  14. (setq olderr *error*)
  15. (defun *error*(msg)
  16. (princ "\n*ERROR*...")
  17. (princ msg)
  18. (princ)
  19. );end defun error.
  20. (defun set_color ( conm / costr )
  21. (defun map_color ( ckey mno )
  22. (start_image ckey)
  23. (fill_image 0 0 (DimX_tile ckey) (DimY_tile ckey) mno)
  24. (end_image)
  25. ) ;end defun
  26. (cond ((= 0 conm)(setq costr "Byblock"))
  27. ((= 1 conm)(setq costr "Red"))
  28. ((= 2 conm)(setq costr "Yellow"))
  29. ((= 3 conm)(setq costr "Green"))
  30. ((= 4 conm)(setq costr "Cyan"))
  31. ((= 5 conm)(setq costr "Bule"))
  32. ((= 6 conm)(setq costr "Magenta"))
  33. ((= 7 conm)(setq costr "color"))
  34. ((= 256 conm)(setq costr "Bylayer"))
  35. ( t (setq costr ""))
  36. ) ;end cond
  37. (cond ((= 0 col) (map_color "col" 7))
  38. ((= 256 col)(map_color "col" (cdr (assoc 62 (tblsearch "layer" lay)))))
  39. (t (map_color "col" conm))
  40. ) ;end cond
  41. (if (= 256 conm)
  42. (set_tile "cnu" (strcat "<" (itoa (cdr (assoc 62 (tblsearch "layer" lay)))) ">" costr))
  43. (set_tile "cnu" (strcat "<" (itoa conm) ">" costr))
  44. ) ;end if
  45. ) ;end set_color
  46. (defun map_keylist( key keylst );set popuplist
  47. (start_list key)
  48. (mapcar 'add_list keylst)
  49. (end_list)
  50. );end map
  51. (defun layer_get_all( / lay layer layname)
  52. (setq layer nil ;;All layer
  53. lay (tblnext "LAYER" T)
  54. )
  55. (while (/= lay nil)
  56. (setq layname (cdr (assoc 2 lay))
  57. layer (cons layname layer))
  58. (setq lay (tblnext "LAYER"))
  59. )
  60. (setq layer (ACAD_Strlsort layer))
  61. layer ;all layer.
  62. ) ;end defun
  63. (defun style_get_all( / sty style sty_list)
  64. (setq sty_list nil sty (tblnext "style" t))
  65. (setq style (cdr (assoc 2 sty)))
  66. (while style
  67. (if (/= "" style)(setq sty_list (append sty_list (list style))))
  68. (setq sty (tblnext "style"))
  69. (setq style (cdr (assoc 2 sty)))
  70. );end while]
  71. (setq sty_list (ACAD_Strlsort sty_list))
  72. sty_list
  73. );end defun
  74. (defun set_error(str)
  75. (set_tile "error" str)
  76. ) ;end defun
  77. (defun sub_mtext ( color entlist / ei newlist)
  78. (setq ei 0 newlist nil)
  79. (while (< ei (length entlist))
  80. (setq newlist (cons (nth ei entlist) newlist))
  81. (if (= 8 (car (nth ei entlist)))
  82. (setq newlist (cons (cons 62 color) newlist))
  83. ) ;end if
  84. (setq ei (1+ ei))
  85. ) ;end while
  86. (reverse newlist)
  87. ) ;end defun
  88. (setq ob1 (entsel "\nChoose any text  to modify :"))
  89. (SETQ obn (car ob1) ptn (car (cdr ob1 )))
  90. (setq obt (car (nentselp ptn)))
  91. (setq oba (cdr (assoc 0 (entget obt))))
  92. (if (or (= oba "TEXT")(= oba "MTEXT")(= oba "ATTRIB"))
  93. (setq otxt (cdr (assoc 1 (entget obt))))
  94. ) ;end if
  95. (if (= oba "ATTDEF")
  96. (setq otxt (cdr (assoc 2 (entget obt))))
  97. ) ;end if
  98. (if otxt
  99. (progn
  100. (setq
  101. sty (cdr (assoc 7 (entget obt)))
  102. lay (cdr (assoc 8 (entget obn)))
  103. hig (cdr (assoc 40 (entget obt)))
  104. wid (cdr (assoc 41 (entget obt)))
  105. ang (cdr (assoc 50 (entget obt)))
  106. ) ;end setq
  107. (if (or (= oba "TEXT")(= oba "MTEXT")(= oba "ATTRIB"))
  108. (setq col (cdr (assoc 62 (entget obt))))
  109. (setq col (cdr (assoc 62 (entget obn))))
  110. ) ;end if
  111. (setq ang (* 180 (/ ang pi)))
  112. (if (null col)(progn (setq cyn 0)(setq col 256))(setq cyn 1))
  113. (setq style (style_get_all))
  114. (setq layer (layer_get_all))
  115. (setq styno (- (length style)(length (member sty style))))
  116. (setq layno (- (length layer)(length (member lay layer))))
  117. (setq dcl_id1 (load_dialog "tm.DCL"))
  118. (if (not (new_dialog "tm" dcl_id1))(exit))
  119. (set_color col)
  120. (set_tile "text" otxt)
  121. (set_tile "hig" (rtos hig 2 2))
  122. (set_tile "wid" (rtos wid 2 2))
  123. (set_tile "ang" (rtos ang 2 2))
  124. (mode_tile "text" 2)
  125. (map_keylist "sty" style)(set_tile "sty" (itoa styno))
  126. (map_keylist "lay" layer)(set_tile "lay" (itoa layno))
  127. (action_tile "text" "(setq txt $value)")
  128. (action_tile "sty" "(setq styno (atoi $value))")
  129. (action_tile "hig" "(setq hig (distof $value))(if (>= 0 hig)(progn (mode_tile "hig" 3)(mode_tile "hig" 2)(set_error "Input error ! "))(set_error ""))")
  130. (action_tile "wid" "(setq wid (distof $value))(if (>= 0 wid)(progn (mode_tile "wid" 3)(mode_tile "wid" 2)(set_error "Input error ! "))(set_error ""))")
  131. (action_tile "lay" "(setq layno (atoi $value))")
  132. (action_tile "col" "(if (setq cnu (ACAD_ColorDlg col))(progn (setq col cnu)(set_color col)))")
  133. (action_tile "ang" "(setq ang (distof $value))")
  134. (action_tile "accept" "(done_dialog 1)")
  135. (action_tile "cancel" "(done_dialog 0)")
  136. (if (= 1 (start_dialog))
  137. (if txt
  138. (progn
  139. (setq sty (nth styno style))
  140. (setq lay (nth layno layer))
  141. (setq ang (* (/ ang 180) pi))
  142. (setq etlst (entget obt))
  143. (if (= oba "ATTDEF")
  144. (setq etlst (subst (cons 2 txt)(assoc 2 etlst) etlst))
  145. (setq etlst (subst (cons 1 txt)(assoc 1 etlst) etlst))
  146. ) ;end if
  147. (setq etlst (subst (cons 7 sty)(assoc 7 etlst) etlst))
  148. (setq etlst (subst (cons 40 hig)(assoc 40 etlst) etlst))
  149. (setq etlst (subst (cons 41 wid)(assoc 41 etlst) etlst))
  150. (setq etlst (subst (cons 50 ang)(assoc 50 etlst) etlst))
  151. (if (= 1 cyn)
  152. (setq etlst (subst (cons 62 col)(assoc 62 etlst) etlst))
  153. (if (= "MTEXT" oba)
  154. (setq etlst (sub_mtext col etlst))
  155. (setq etlst (cons (cons 62 col) etlst))
  156. ) ;end if
  157. ) ;end if
  158. (entmod etlst)
  159. (setq etlst (subst (cons 8 lay)(assoc 8 (entget obn)) (entget obn)))
  160. (entmod etlst)
  161. (entupd obt)
  162. (entupd obn)
  163. )
  164. ) ;end if
  165. );end if
  166. (if (= 11 (start_dialog))(Command "_help"))
  167. ) ;end progn
  168. ) ;end if
  169. (setq *error* olderr)
  170. (EF:UNDOEnd)
  171. (princ)
  172. ) ;end defun

 
 
以下是DCL文件
 
  1. //SUPERDDEDIT
  2. tm: dialog {
  3. label = "Text editing...";
  4. : boxed_radio_column {
  5. label = "Super text editor...";
  6. : edit_box { label= "text:"; key = "text"; edit_width = 50; }
  7. : row {
  8. : popup_list {label="Style"; key = "sty"; edit_width = 13; fixed_width = true;}
  9. : edit_box {label="Height"; key = "hig"; edit_width = 7; fixed_width = true;}
  10. : edit_box {label="Width"; key = "wid"; edit_width = 7; fixed_width = true;}
  11. }
  12. : row {
  13. : popup_list {label="Layer"; key = "lay"; edit_width = 13; fixed_width = true;}
  14. : image_button {key = "col"; width= 4; aspect_ratio = 0.75; fixed_width = true;}
  15. : text_part {key = "cnu"; width= 12;fixed_width = true; }
  16. : edit_box {label="Angle"; key = "ang"; edit_width = 7; fixed_width = true;}
  17. }
  18. spacer_1;
  19. }
  20. : row {
  21. alignment = right;
  22. : spacer {width = 1; fixed_width = true;}
  23. ok_cancel;
  24. }
  25. errtile;
  26. }
回复

使用道具 举报

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-6 00:03:14 | 显示全部楼层
你们只需要使用一个while循环,所以只要在屏幕上选择任何并没有什么可以退出的地方
 
 
  1. (while (/= (setq ob1 (entsel "\nChoose any text  to modify :")) nil)
  2. your code
  3. ....find the correct spot in your code
  4. ) ; end while
回复

使用道具 举报

34

主题

174

帖子

60

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
257
发表于 2022-7-6 00:17:00 | 显示全部楼层
 
 
加载错误
回复

使用道具 举报

34

主题

174

帖子

60

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
257
发表于 2022-7-6 00:24:13 | 显示全部楼层
谁能帮我?
回复

使用道具 举报

0

主题

301

帖子

301

银币

初来乍到

Rank: 1

铜币
0
发表于 2022-7-6 00:32:24 | 显示全部楼层
flyfox1047,
 
上传对话框文件tm。dcl,如果你想让我们帮助你。
 
ymg公司
回复

使用道具 举报

34

主题

174

帖子

60

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
257
发表于 2022-7-6 00:40:59 | 显示全部楼层
 
非常感谢。已补充
回复

使用道具 举报

0

主题

301

帖子

301

银币

初来乍到

Rank: 1

铜币
0
发表于 2022-7-6 00:57:10 | 显示全部楼层
flyfox1047,
 
我真的不认为这样做有什么意义。
 
您可以通过更改属性来完成同样的操作,而不用使用Lisp的这一部分。
例如,选择所需数量的文字实体,夹点将打开。发出命令ch
现在,在属性框中,可以更改高度和样式。
 
修改该程序类似于重新创建该功能。
 
ymg公司
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-10 21:08 , Processed in 0.600597 second(s), 66 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表