标注界址点号lisp_动态引线标注(改版) - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - 动态 - Powered by Discuz!...
本帖最后由 958620832 于 2013-10-16 12:01 编辑
兄弟贴:动态引线标注 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=102054
从自身需要予以改版,现公布于众。
该程序具有如下几大特点:
1.设置缺省值,代替兄弟程序中对于档案的保存和调用,个人习惯而已。
2.线上和线下都可以写入文字,应用范围更广 。而兄弟程序中,文字只能写在线上。
(defun bz (/ *error* name1 name2 name3)
(defun *error* (msg) ;将描述错误的字符串存入变量msg
(entdel name1) (entdel name2) (if name3 (entdel name3))
(princ "错误: ")(princ msg)) ;打印错误信息
(setq ty (getvar "TEXTSTYLE"))
(setq kd1 (caadr (textbox (list '(0 . "text")(cons 1 txt1)(cons 40 300)(cons 41 0.7)(cons 7 ty)))))
;字高300,字宽高比0.7,可以自己设置,字体为当前字体
(setq kd2 (caadr (textbox (list '(0 . "text")(cons 1 txt2)(cons 40 300)(cons 41 0.7)(cons 7 ty)))))
;字高300,字宽高比0.7,可以自己设置,字体为当前字体
(setq kd (max kd1 kd2) kd (+ kd 50))
(setq p (getpoint "\n输入基点:"))
(setq pd t)
(while pd
(setq gr (grread t 4 1) mode (car gr) pt (cadr gr))
(if (= kd3 0) (setq kd kd1))
(if (and (listp pt) (>= (car pt) (car p))) (progn
(setq p0 (polar pt 0 kd))
(setq p1 (polar pt 0 (/ (- kd kd1) 2)) p1 (polar p1 (angtof "90") 50))
(setq p2 (polar pt 0 (/ (- kd kd2) 2)) p2 (polar p2 (angtof "270") 350))))
(if (and (listp pt) (< (car pt) (car p))) (progn
(setq p0 (polar pt pi kd))
(setq p1 (polar p0 0 (/ (- kd kd1) 2)) p1 (polar p1 (angtof "90") 50))
(setq p2 (polar p0 0 (/ (- kd kd2) 2)) p2 (polar p2 (angtof "270") 350))))
(if (= mode 5) (progn
(if name1 (entdel name1))
(entmake (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")'(100 . "AcDbPolyline")'(90 . 3)
(cons 10 p)(cons 10 pt)(cons 10 p0)))
(setq name1 (entlast))
(if name2 (entdel name2))
(entmake (list '(0 . "text")(cons 1 txt1)(cons 40 300)(cons 41 0.7)(cons 10 p1)(cons 7 ty)))
;字高300,字宽高比0.7,可以自己设置,字体为当前字体
(setq name2 (entlast))
(if name3 (entdel name3))
(if (= kd3 1) (entmake (list '(0 . "text")(cons 1 txt2)(cons 40 300)(cons 41 0.7)(cons 10 p2)(cons 7 ty))))
;字高300,字宽高比0.7,可以自己设置,字体为当前字体
(if (= kd3 1) (setq name3 (entlast)))))
(if (= mode 3) (setq pd nil))
(if (or (= mode 2) (= mode 25)) (progn (setq pd nil) (entdel name1) (entdel name2) (if name3 (entdel name3)))))
(princ))
(defun getdata ()
(setq txt1 (get_tile "a1"))
(setq txt2 (get_tile "a2"))
(if (= (get_tile "a3") "0") (setq kd3 0) (setq kd3 1)))
(defun c:yxbz ()
;(步骤1)建立临时对话框
(setq tempname (vl-filename-mktemp "temp.dcl") filen (open tempname "w"))
(foreach stream
'("yxbz:dialog{"
"\n label = "动态引线标注";"
"\n :edit_box {key = \"a1\"; label = \"线上文字:\"; width = 40 ;}"
"\n :toggle {key = \"a3\"; label = \"增加线下文字\"; value = "0";}"
"\n :edit_box {key = \"a2\"; label = \"线下文字:\"; width = 40; is_enabled = false;}"
"\n ok_cancel;}")
(princ stream filen))
(close filen)
(setq dclname tempname)
;(步骤2)加载并显示对话框
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "yxbz" dcl_re)) (exit))
;(步骤3)定义对话框控件(运用set_tile、action_tile、mode_tile、get_tile等函数)
(if txt1 (set_tile "a1" txt1) (set_tile "a1" "动态标注"))
(if txt2 (set_tile "a2" txt2) (set_tile "a2" "动态标注"))
(if kd3 (set_tile "a3" (rtos kd3))) ;注意set_tile函数中赋值均为字符串(带双引号),就连关键词也要加上双引号。
(if (= kd3 0) (mode_tile "a2" 1))
(if (= kd3 1) (mode_tile "a2" 0))
(action_tile "a3" "(if (= (get_tile \"a3\") \"0\") (mode_tile \"a2\" 1) (mode_tile \"a2\" 0))") ;点击时才起作用
(action_tile "accept" "(getdata)(done_dialog 1)")
(action_tile "cancel" "(done_dialog)")
;(步骤4)激活并卸载对话框,并进行对话框隐藏后的操作。
(setq std (start_dialog))
(unload_dialog dcl_re)
(vl-file-delete dclname)
(if (= std 1) (bz))
(princ))
标注界址点号lisp_动态引线标注(改版) - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - 动态 - Powered by Discuz!...相关推荐
- lisp写标高线_属性块形式的标高标注程序! - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
欢迎来拍砖 说明:由于本人经常要用标高做一些计算(尤其是总图),所以个人认为做成属性标高有利于其他程序直接调用数据(比如说计算总图排水坡度坡向等),所以用标高块的形式做标高,喜欢的可以拿去用用.... ...
- lisp文字上标源码_创建文本/标注样式源码 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
本帖最后由 zhengxiansz 于 2014-4-27 11:27 编辑 GU_xl你好! 请帮我看一下这个创建文本/标注样式源码.第一次输入IT1命令时没有报错的提示.如果重复输入IT1命令时就 ...
- LISP 圆孔标记_做了一个检查图框内字体和标注的插件 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
本帖最后由 WWYYBB1015 于 2019-12-16 21:04 编辑 根据大家的要求,更新一下修改标注文字引线的功能.插件会根据图框比例自动创建一个新的标注样式,例如:名称为机械标注5.找到代 ...
- lisp新建标注式样_创建标注样式后续消零问题 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
DIMASO 关 创建标注对象 DIMSTYLE ISO-25 当前标注样式 (只读) DIMADEC 0 ...
- 方孔分段的lisp_常用函数.lsp - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
本帖最后由 自贡黄明儒 于 2013-11-11 12:57 编辑 ;;各位,把你们收藏都拿出秀一秀呀,放在箱底会生霉的 ;;我的收集是在caoyin发布的通用函数基础上扩展的----自贡黄明儒 20 ...
- lisp绘制棱锥_动态绘制示坡线 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
本帖最后由 20060510412 于 2018-11-4 22:11 编辑 [code="lisp] ;; ;;动态示坡线 by 明经通道 QQ9034598 小蜜蜂 2013- ...
- cad四边形展开lisp_批量绘制四边形 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
;试用以下程序 (defun c:test() (setq bcsjb '(("A1" 9549.31 6977.53 7180.75 7155.97 11015.11) (&qu ...
- cad抛物线曲线lisp_曲线的转弯半径和曲率 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
;;;============================================================= ;;; 一般平面曲线参数方程的曲率离心公式 ;;; 功能: 获取曲线上 ...
- cad线段总和lisp_求一个线段长度总和与生成文本 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
像这种 ;;;;;计算面积,周长.显视在图面上 (defun C:am (/ s text1 text2 ss l i totalarea ename obj insertpt insertpt1) ...
最新文章
- android TranslateAnimation动画执行时的坐标获取。
- 【题解】 [HNOI2015]落忆枫音 (拓扑排序+dp+容斥原理)
- python urllib.request 爬虫 数据处理-python爬虫之json数据处理
- 【转载】SpringBoot系列——Swagger2
- Spring boot mongodb
- Android 如何调用系统默认浏览器访问
- elementui 菜单标题_elementUI 动态渲染三级菜单
- PHP新手之学习类与对象(4)
- 【个人笔记】OpenCV4 C++ 快速入门 10课
- 【渝粤教育】国家开放大学2018年秋季 1121t健康教育与健康促进 参考试题
- 【LeetCode 231】Power of Two
- hdu4588Count The Carries
- 5G时代下的移动边缘计算(MEC)探索系列之二
- 【软件相关】Proteus 8入门教程
- 制作微软引导盘实现装系统0失败uefi启动MediaCreationTool
- 文档数据库mongodb与列式数据库hbase详细比较
- bluetoothctl 工具的使用
- vue+element 实现时间选择器切换周月选择
- 怎么实现红鲤鱼与绿鲤鱼与驴代码
- 产品生命周期优化法PACE