明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: 尘缘一生

[函数] 右键菜单函数改进版

[复制链接]
发表于 2016-6-2 08:29 | 显示全部楼层
请问一下,空白文字写出的字体高度,是哪个参数调整的

点评

不对,说错啦,在 (entmake (list '(0 . "TEXT") (cons 1 wz) (cons 10 p1) (cons 40 3)));【cons 40 3】  发表于 2016-6-2 16:15
在右键菜单函数里。  发表于 2016-6-2 16:11
发表于 2016-6-8 00:16 | 显示全部楼层
改进得很实用,谢谢你
 楼主| 发表于 2016-6-8 07:39 | 显示全部楼层
进一步改进
在使用过程中,最后需要移动定位,增加写出后
【直接跟随鼠标就位功能】。
  1. ;;; --------------改、写箍筋----------------------------------
  2. (defun c:gujin (/ wzlst)
  3.   (setq wzlst (list "%%1326@100" "%%1326@120" "%%1326@150" "%%1326@200" "%%1326@250"
  4.                     "%%1326@300" "%%1328@100" "%%1328@120" "%%1328@150" "%%1328@200"
  5.                     "%%1328@250" "%%1328@300" "%%13210@100" "%%13210@120" "%%13210@150"
  6.                     "%%13210@200" "%%13210@250" "%%13210@300"
  7.               )
  8.   )
  9.   (yy:gangjin wzlst)
  10. )
  11. ;;; --------------改、写一根不同直径的三级钢筋----------------------------------
  12. (defun c:1-3 (/ wzlst)
  13.   (setq wzlst (list "%%1326" "%%1328" "%%13210" "%%13212" "%%13214" "%%13216" "%%13218"
  14.                     "%%13220" "%%13222" "%%13225" "%%13228" "%%13230"
  15.               )
  16.   )
  17.   (yy:gangjin wzlst)
  18. )
  19. ;;; --------------改、写二根不同直径的三级钢筋----------------------------------
  20. (defun c:2-3 (/ wzlst)
  21.   (setq wzlst (list "2%%1326" "2%%1328" "2%%13210" "2%%13212" "2%%13214" "2%%13216"
  22.                     "2%%13218" "2%%13220" "2%%13222" "2%%13225" "2%%13228" "2%%13230"
  23.               )
  24.   )
  25.   (yy:gangjin wzlst)
  26. )
  27. ;;; --------------改、写三根不同直径的三级钢筋----------------------------------
  28. (defun c:3-3 (/ wzlst)
  29.   (setq wzlst (list "3%%1326" "3%%1328" "3%%13210" "3%%13212" "3%%13214" "3%%13216"
  30.                     "3%%13218" "3%%13220" "3%%13222" "3%%13225" "3%%13228" "3%%13230"
  31.               )
  32.   )
  33.   (yy:gangjin wzlst)
  34. )
  35. ;;; --------------改、写四根不同直径的三级钢筋----------------------------------
  36. (defun c:4-3 (/ wzlst)
  37.   (setq wzlst (list "4%%1326" "4%%1328" "4%%13210" "4%%13212" "4%%13214" "4%%13216"
  38.                     "4%%13218" "4%%13220" "4%%13222" "4%%13225" "4%%13228" "4%%13230"
  39.               )
  40.   )
  41.   (yy:gangjin wzlst)
  42. )
  43. ;;; --------------改、写钢筋函数------------------------------------------------
  44. (defun yy:gangjin (wzlst / en wztxt len oldwz len1 snap wz *error* error_end)
  45.   (vl-load-com)
  46.   (defun *error* (x)
  47.     (error_end)
  48.     (command "_.undo" "1")
  49.   )
  50.   (defun error_end ()
  51.     (and
  52.       snap
  53.       (setvar "osmode" snap)
  54.     )                                  ; 打开捕捉
  55.     (command "_.undo" "e")             ; 结束编组
  56.                                        ; 回到当初
  57.     (redraw)                           ; 刷新当前

  58.   )                                    ; 主函数
  59.   (command "_.undo" "be")
  60.   (setq len (* 88 (/ (getvar "viewsize") (cadr (getvar "screensize"))))
  61.         oldwz wztxt
  62.         len1 (* 0.26 5 len)
  63.   )                                    ; 计算横向长度
  64.   (setq en (entsel "\n选择要修改的文字,左键空点写出文字:"))
  65.   (if (and
  66.         (/= nil en)
  67.         (setq wztxt (dxf_read 1 (car en)))
  68.       )
  69.     (progn
  70.       (setq snap (getvar "osmode"))
  71.       (setvar "osmode" 0)              ; 关闭
  72.       (setq wz (cadr (yy:yjcaidan (cadr en) len len1 wzlst oldwz))) ; 调用菜单函数
  73.       (yy_subupd (car en) 1 wz)        ; 此处放回调函数
  74.     )                                  ; end progn
  75.   )                                    ; end if
  76.                                     
  77.   (if (= nil en)                       ; 假如空点
  78.     (progn
  79.       (setq p1 (nth 1 (grread 5)))     ; (setq p1 (getpoint "\n选择文字插入点:"))
  80.       (setq snap (getvar "osmode"))
  81.       (setvar "osmode" 0)              ; 关闭
  82.       (setq wz (cadr (yy:yjcaidan p1 len len1 wzlst oldwz))) ; 调用菜单函数
  83.       (entmake (list '(0 . "TEXT") (cons 1 wz) (cons 10 p1) (cons 40 3)))
  84.       (command "MOVE" (entlast) "" p1 pause"")
  85.     )                                  ; progn
  86.   )                                    ; end if
  87.                                     
  88.   (error_end)
  89.   (princ)
  90. )
  91. ;;; end defun
  92. ;;; ======================================右键菜单函数v1.0--先关闭捕捉===========by
  93. ;;; wowan1314
  94. ;;; pt表格产生点,len格子大小。tuxian为要作底的文字内容.
  95. ;;; wzlst为要写的文字表.len1横向长度,共计5个参数tuxian可为nil,其他必须有值.
  96. ;;; 表格横向固定2格,竖向多少格由文字表决定. 横向长度自定. 文字样式随当前
  97. ;;; 返回值:表(1 "dn15").第一个表示选择的第几格,第二项为文字内容.
  98. ;;; ======================================================================================
  99. ;;; =
  100. ;;; =====;;
  101. (defun yy:yjcaidan (pt len len1 wzlst tuxian / do_move x y pmpt x1 x0 y0 y1 gplst hangshu i
  102.                        been p1 p2 p3 p4 plst p1lst wipe wznamlst wzgz wpt wzhigh yh_spc
  103.                        yh_text wz oldhi beend loop code newwz
  104.                    )                   ; ================================动态函数
  105.   (defun do_move (pt0 / i gpt wzgz wz high wz1)
  106.     (setq i -1)
  107.     (while (and
  108.              i
  109.              (< i (length gplst))
  110.            )
  111.       (setq i (1+ i)
  112.             wzgz (nth i gplst)
  113.       )
  114.       (if (and
  115.             (< (car (car wzgz)) (car pt0) (car (cadr wzgz)))
  116.             (< (cadr (car wzgz)) (cadr pt0) (cadr (cadr wzgz)))
  117.             (setq wz (nth i wznamlst))
  118.           )
  119.         (progn
  120.           (setq high (* 1.2 (dxf_read 40 (cadr wz))))
  121.           (setq wz1 (car wz)
  122.                 wz (cadr wz)
  123.           )
  124.           (if (/= wz1 oldwz1)
  125.             (progn
  126.               (redraw)
  127.               (yy_subupd wz 62 6)
  128.               (yy_subupd wz 40 high)
  129.               (yy_subupd oldwz 62 3)
  130.               (yy_subupd oldwz 40 oldhi)
  131.               (setq oldwz1 wz1
  132.                     oldwz wz
  133.               )
  134.               (grvecs (list -6 (car wzgz) (caddr wzgz) -6 (caddr wzgz) (cadr wzgz) -6
  135.                             (cadr wzgz) (last wzgz) -6 (last wzgz) (car wzgz)
  136.                       )
  137.               )
  138.             )
  139.           )
  140.           (setq num (1+ i)
  141.                 i nil
  142.           )
  143.         )
  144.       )
  145.     )
  146.     (if i
  147.       (progn
  148.         (yy_subupd oldwz 62 3)
  149.         (yy_subupd oldwz 40 oldhi)
  150.         (setq oldwz1 nil
  151.               oldwz nil
  152.         )
  153.         (redraw)
  154.       )
  155.     )
  156.   )                                    ; 主程序
  157.   (setq x (car pt)
  158.         y (cadr pt)
  159.   )
  160.   (setq pmpt (yy_pm2pt)
  161.         x1 (+ x (* 2 len1))
  162.         x0 (car (cadr pmpt))
  163.         y0 (cadr (car pmpt))
  164.         y1 (- y (* (atoi (rtos (* (length wzlst) 0.5) 2 0)) 0.5 len))
  165.   )
  166.   (and
  167.     (> x1 x0)
  168.     (setq x (- x (- x1 x0)))
  169.   )                                    ; 当超过屏幕右边线
  170.   (and
  171.     (< y1 y0)
  172.     (setq y (+ y (- y0 y1)))
  173.   )                                    ; 当超过屏幕底边线
  174.                                        ; 计算起始点及wipeout作底
  175.   (setq gplst '())
  176.   (setq hangshu (1+ (atoi (rtos (* (length wzlst) 0.5) 2 0)))
  177.         i 1
  178.         been (entlast)
  179.         y1 (- y (* (atoi (rtos (* (length wzlst) 0.5) 2 0)) 0.5 len))
  180.   )
  181.   (setq p1 (list x y 0)
  182.         p2 (list (+ x (* 2 len1)) y 0)
  183.         p3 (list x y1 0)
  184.         p4 (list (+ x (* 2 len1)) y1 0)
  185.   )                                    ; 先画底框.用wipeout作底比solid好些
  186.                                        ; (vl-cmdf "wipeout" p1 p2 p4 p3 "")
  187.   (gxl-makewipeout (list p1 p2 p4 p3)) ; (yy:solid p1 p2 p3 p4 18)
  188.   (while (<= i hangshu)
  189.     (setq p1 (list x y 0)
  190.           p2 (list (+ x (* 2 len1)) y 0)
  191.           p3 (list (+ x len1) y 0)
  192.           y (- y (* len 0.5))
  193.     )
  194.     (yy:makline p1 p2 7 "Continuous")
  195.     (if (> i 1)
  196.       (setq gplst (cons (list p3 (cadr plst) p2 (last plst)) (cons (list p1 (last plst) p3
  197.                                                                          (car plst)
  198.                                                                    ) gplst
  199.                                                              )
  200.                   )
  201.       )
  202.     )
  203.     (setq plst (list p1 p2 p3))
  204.     (if (= i 1)
  205.       (setq p1lst plst)
  206.     )
  207.     (setq i (1+ i))
  208.   )                                    ; 画横线结束
  209.   (setq gplst (reverse gplst))         ; 画竖线
  210.   (yy:makline (car p1lst) (car plst) 7 "Continuous")
  211.   (yy:makline (cadr p1lst) (cadr plst) 7 "Continuous")
  212.   (yy:makline (caddr p1lst) (caddr plst) 7 "Continuous")
  213.   (setq wipe (entlast)
  214.         wznamlst '()
  215.   )
  216.   (setq i -1)
  217.   (foreach wz wzlst
  218.     (setq i (1+ i)
  219.           wzgz (nth i gplst)
  220.           wpt (yy:mid (car wzgz) (cadr wzgz))
  221.     )
  222.     (setq wzhigh (* 0.23 len))
  223.     (and
  224.       (= wz tuxian)
  225.       (yy:solid (car wzgz) (caddr wzgz) (last wzgz) (cadr wzgz) 19) ; 原文字对应的底框soli
  226.                                        ; d
  227.                                        ; 实体
  228.                                        ; (setq sold (entlast))
  229.     )
  230.     (if (not *yh_doc*)
  231.       (setq *yh_doc* (vla-get-activedocument (vlax-get-acad-object)))
  232.     )                                  ; 获取当前图档指针
  233.     (setq yh_spc (vla-get-modelspace *yh_doc*)) ; 获取当前图档模型空间指针
  234.     (setq yh_text (vla-addtext yh_spc wz (vlax-3d-point wpt) wzhigh)) ; 生成文字
  235.     (vla-put-alignment yh_text acalignmentmiddle) ; 对齐方式设为居中对齐
  236.     (vla-put-textalignmentpoint yh_text (vlax-3d-point wpt)) ; 将文字归位
  237.     (vla-put-stylename yh_text (getvar "TEXTSTYLE")) ; 修改文字的样式
  238.     (vla-put-color yh_text 1)          ; 修改文字的颜色
  239.     (setq wznamlst (cons (list wz (entlast)) wznamlst))
  240.   )
  241.   (setq wznamlst (reverse wznamlst))
  242.   (setq wz (nth 0 wznamlst)
  243.         oldhi (dxf_read 40 (cadr wz))
  244.   )
  245.   (setq beend (last_ent been))         ; 所有产生的物体的选择集
  246.                                        ; 动态部分
  247.   (setq loop t)
  248.   (while loop
  249.     (setq code (grread nil 13 2))
  250.     (cond
  251.       ((not (member (car code) '(3 11 25)))
  252.         (do_move (cadr code))
  253.       )                                ; 移动
  254.       ((member (car code) '(11 25))
  255.         (setq loop nil)
  256.       )                                ; 右键 退出
  257.       ((= (car code) 3)
  258.         (do_move (cadr code))
  259.         (and
  260.           oldwz1
  261.           (setq loop nil)
  262.         )
  263.       )
  264.     )
  265.   )
  266.   (if oldwz1
  267.     (setq newwz oldwz1)
  268.   )
  269.   (command "ERASE" beend "")           ; 删除过程物
  270.   (redraw)
  271.   (list num newwz)
  272. )
  273. ;;; ======================函数取得en之后生成的所有图元的选择集
  274. (defun last_ent (en / ss)
  275.   (if en
  276.     (progn
  277.       (setq ss (ssadd))
  278.       (while (setq en (entnext en))
  279.         (if (not (member (cdr (assoc 0 (entget en))) '("ATTRIB" "VERTEX"
  280.                           "SEQEND"
  281.                          )
  282.                  )
  283.             )
  284.           (ssadd en ss)
  285.         )                              ; if
  286.       )                                ; while
  287.       (if (zerop (sslength ss))
  288.         (setq ss nil)
  289.       )
  290.       ss
  291.     )                                  ; progn
  292.     (ssget "_x")
  293.   )                                    ; if

  294. )
  295. ;;; ===========================================entmake line
  296. ;;; 调用形式 (yy:makline 起点坐标  终点坐标 颜色 线型),如果成功,返回定义数据的图元表
  297. (defun yy:makline (liststartpoint listendpoint col linetyle)
  298.   (entmake (list '(0 . "LINE") (cons 62 col) (cons 6 linetyle) (cons 10 liststartpoint)
  299.                  (cons 11 listendpoint)
  300.            )
  301.   )
  302. )
  303. ;;; =================================求中点函数
  304. (defun yy:mid (p1 p2 / x y)
  305.   (if (= (length p1) (length p2))
  306.     nil
  307.     (setq p1 (list (car p1) (cadr p1))
  308.           p2 (list (car p2) (cadr p2))
  309.     )
  310.   )
  311.   (mapcar
  312.     '(lambda (x y)
  313.        (/ (+ x y) 2.0)
  314.      )
  315.     p1
  316.     p2
  317.   )
  318. )
  319. ;;; ================================制作sold填充函数
  320. (defun yy:solid (p1 p2 p3 p4 col)
  321.   (entmakex (list (cons 0 "SOLID") (cons 100 "AcDbEntity") (cons 62 col) (cons 100
  322.                                                                                "AcDbTrace"
  323.                                                                          ) (cons 10 p1)
  324.                   (cons 11 p2) (cons 12 p3) (cons 13 p4)
  325.             )
  326.   )
  327. )
  328. ;;; ===================================根据图元名读 组码函数
  329. (defun dxf_read (code ename)
  330.   (cdr (assoc code (entget ename)))
  331. )
  332. ;;; ================================================(gxl-makewipeout pts) 绘制wipeout by
  333. ;;; gu_xl
  334. ;;; 用法: (gxl-makewipeout (list (getpoint "\n点:") (getpoint "\n点:") (getpoint "\n点:")
  335. ;;; (getpoint "\n点:")))
  336. (defun gxl-makewipeout (pts / ll ur wh w h cp lst ang)
  337.   (if (not (member "acwipeout.arx" (arx)))
  338.     (arxload "acwipeout.arx")
  339.   )
  340.   (if (not (equal (car pts) (last pts) 1e-6))
  341.     (setq pts (cons (last pts) pts))
  342.   )
  343.   (setq ll (apply
  344.              'mapcar
  345.              (cons 'min pts)
  346.            )
  347.         ur (apply
  348.              'mapcar
  349.              (cons 'max pts)
  350.            )
  351.         wh (mapcar
  352.              '-
  353.              ur
  354.              ll
  355.            )
  356.         w (car wh)
  357.         h (cadr wh)
  358.         cp (mapcar
  359.              '*
  360.              (mapcar
  361.                '+
  362.                ll
  363.                ur
  364.              )
  365.              '(0.5 0.5 0.5)
  366.            )
  367.   )
  368.   (foreach pt pts
  369.     (setq lst (cons (list 14 (/ (car (setq pt (mapcar
  370.                                                 '-
  371.                                                 pt
  372.                                                 cp
  373.                                               )
  374.                                      )
  375.                                 ) w
  376.                              ) (- (/ (cadr pt) h))
  377.                     ) lst
  378.               )
  379.     )
  380.   )
  381.   (setq lst (reverse lst))
  382.   (entmakex (append
  383.               (list '(0 . "WIPEOUT") '(100 . "AcDbEntity") '(100 . "AcDbWipeout")
  384.                     (cons 10 ll) (list 11 w 0.0) (list 12 0.0 h) '(280 . 1) '(71 . 2)
  385.               )
  386.               lst
  387.             )
  388.   )
  389. )
  390. ;;; yy_subupd =========更新组码以修改实体函数
  391. (defun yy_subupd (ename code val / ent x y i s1)
  392.   (if (= (type ename) 'ename)
  393.     (progn
  394.       (setq ent (entget ename))
  395.       (if (and
  396.             (= (type code) 'list)
  397.             (= (type val) 'list)
  398.           )
  399.         (mapcar
  400.           '(lambda (x y)
  401.              (yy_subupd ename x y)
  402.            )
  403.           code
  404.           val
  405.         )
  406.         (progn
  407.           (if (= (dxf_read code ename) nil)
  408.             (entmod (append
  409.                       ent
  410.                       (list (cons code val))
  411.                     )
  412.             )
  413.             (entmod (subst
  414.                       (cons code val)
  415.                       (assoc code ent)
  416.                       ent
  417.                     )
  418.             )
  419.           )
  420.           (entupd ename)
  421.         )
  422.       )
  423.     )
  424.   )
  425.   ename
  426. )
  427. ;;; ==========================求屏幕两对角点
  428. (defun yy_pm2pt (/ a b c d x)
  429.   (setq b (getvar "viewsize")
  430.         c (car (getvar "screensize"))
  431.         d (cadr (getvar "screensize"))
  432.         a (* b (/ c d))
  433.         x (trans (getvar "viewctr") 1 2)
  434.         c (trans (list (- (car x) (* a 0.5)) (- (cadr x) (* b 0.5)) 0.0) 2 1)
  435.         d (trans (list (+ (car x) (* a 0.5)) (+ (cadr x) (* b 0.5)) 0.0) 2 1)
  436.   )
  437.   (list c d)
  438. )
  439. ==========================             ;
发表于 2016-7-17 16:28 | 显示全部楼层
请问楼主字体设置成当前字体的话怎么改,谢谢!
发表于 2016-7-18 19:05 | 显示全部楼层
是啊。应该把标注的字体做成随挡前的比例,同时问一下:怎么修改可以是弹出的字体小点,表格也密一点?紧凑一点
发表于 2018-1-16 16:58 | 显示全部楼层
尘缘一生 发表于 2016-6-8 07:39
进一步改进
在使用过程中,最后需要移动定位,增加写出后【直接跟随鼠标就位功能】。

请问,空白文字的字体类型如何修改调整,是哪个参数控制?
发表于 2018-1-23 10:47 | 显示全部楼层
好东西,菜单选择工具,很棒,以后下载学习
发表于 2018-1-28 22:49 | 显示全部楼层
尘缘一生 发表于 2016-5-28 22:24
我对此函数构件几个命令,主要是自己使用,附件全部已更新。
此函数发布多时,一直应用不到,很是遗憾,应 ...

谢谢,非常实用
发表于 2018-7-4 11:56 | 显示全部楼层
菜单怎么弄成两层?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 19:17 , Processed in 0.428723 second(s), 20 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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