右键菜单函数改进版
本帖最后由 尘缘一生 于 2016-5-29 16:55 编辑一：参考资源：
http://bbs.mjtd.com/thread-101509-1-1.html
二：改进：
1：增加鼠标左键点击空白处写出文字功能。
2：增加 (vl-load-com) 语句，以便空加载调试不通过。
3：容易费解的说明去掉部分。
4：去掉一个屏幕尺寸函数，就是一个语句而已。
5：构造命令之前的主函数一个，以便命令简化。
6：其他格式细节等。
三：缺点：
while 循环没有完成，期待大家完善，从实际工作出发，也不是必须的。
四：压缩包
主函数与右键菜单函数打包一并发上，没有分开。
五：主函数如下：;;; --------------改、写箍筋----------------------------------
(defun c:gujin (/ wzlst)
(setq wzlst (list "%%1326@100" "%%1326@120" "%%1326@150" "%%1326@200" "%%1326@250"
"%%1326@300" "%%1328@100" "%%1328@120" "%%1328@150" "%%1328@200"
"%%1328@250" "%%1328@300" "%%13210@100" "%%13210@120" "%%13210@150"
"%%13210@200" "%%13210@250" "%%13210@300"
)
)
(yy:gangjin wzlst)
)
;;; --------------改、写一根不同直径的三级钢筋----------------------------------
(defun c:1-3 (/ wzlst)
(setq wzlst (list "%%1326" "%%1328" "%%13210" "%%13212" "%%13214" "%%13216" "%%13218"
"%%13220" "%%13222" "%%13225" "%%13228" "%%13230"
)
)
(yy:gangjin wzlst)
)
;;; --------------改、写二根不同直径的三级钢筋----------------------------------
(defun c:2-3 (/ wzlst)
(setq wzlst (list "2%%1326" "2%%1328" "2%%13210" "2%%13212" "2%%13214" "2%%13216"
"2%%13218" "2%%13220" "2%%13222" "2%%13225" "2%%13228" "2%%13230"
)
)
(yy:gangjin wzlst)
)
;;; --------------改、写三根不同直径的三级钢筋----------------------------------
(defun c:3-3 (/ wzlst)
(setq wzlst (list "3%%1326" "3%%1328" "3%%13210" "3%%13212" "3%%13214" "3%%13216"
"3%%13218" "3%%13220" "3%%13222" "3%%13225" "3%%13228" "3%%13230"
)
)
(yy:gangjin wzlst)
)
;;; --------------改、写四根不同直径的三级钢筋----------------------------------
(defun c:4-3 (/ wzlst)
(setq wzlst (list "4%%1326" "4%%1328" "4%%13210" "4%%13212" "4%%13214" "4%%13216"
"4%%13218" "4%%13220" "4%%13222" "4%%13225" "4%%13228" "4%%13230"
)
)
(yy:gangjin wzlst)
)
;;; --------------改、写钢筋函数------------------------------------------------
(defun yy:gangjin (wzlst / en wztxt len oldwz len1 snap wz *error* error_end)
(vl-load-com)
(defun *error* (x)
(error_end)
(command "_.undo" "1")
)
(defun error_end ()
(and
snap
(setvar "osmode" snap)
) ; 打开捕捉
(command "_.undo" "e") ; 结束编组
; 回到当初
(redraw) ; 刷新当前
)
(command "_.undo" "be")
(setq len (* 88 (/ (getvar "viewsize") (cadr (getvar "screensize"))))
oldwz wztxt
len1 (* 0.26 5 len)
) ; 计算横向长度
(setq en (entsel "\n选择要修改的文字,左键空点写出文字："))
(if (and
(/= nil en)
(setq wztxt (dxf_read 1 (car en)))
)
(progn
(setq snap (getvar "osmode"))
(setvar "osmode" 0) ; 关闭
(setq wz (cadr (yy:yjcaidan (cadr en) len len1 wzlst oldwz))) ; 调用菜单函数
(yy_subupd (car en) 1 wz) ; 此处放回调函数
) ; end progn
) ; end if
(if (= nil en) ; 假如空点
(progn
(setq p1 (nth 1 (grread 5))) ; (setq p1 (getpoint "\n选择文字插入点:"))
(setq snap (getvar "osmode"))
(setvar "osmode" 0) ; 关闭
(setq wz (cadr (yy:yjcaidan p1 len len1 wzlst oldwz))) ; 调用菜单函数
(entmake (list '(0 . "TEXT") (cons 1 wz) (cons 10 p1) (cons 40 3)))
) ; progn
) ; end if
(error_end)
(princ)
)
;;; end defun wzg356 发表于 2016-5-27 18:52 static/image/common/back.gif
不是你的，求改进算了，还好意思收币
有改进的哦 尘缘一生 发表于 2016-6-8 07:39
进一步改进
在使用过程中，最后需要移动定位，增加写出后【直接跟随鼠标就位功能】。
请问，空白文字的字体类型如何修改调整，是哪个参数控制？ 不是你的，求改进算了，还好意思收币 这个很容易实现... 图片上wipeout怎没么被你改没了？跟背景重叠看不清
不是你的，求改进算了，还好意思收币 我对此函数构件几个命令，主要是自己使用，附件全部已更新。
此函数发布多时，一直应用不到，很是遗憾，应用的后续路子，一直无人开发，私下问过一些，要花钱？
无奈之下自己写一些基本应用，发牢骚者自便，发这里是给这些基本用户用的。
支持一下改进软件不容易！！ 13版以上cad，出来选择的那个界面后，按esc键，还会不会停留？ 支持一下哦