lisp调用qleader端点_标注时自动切换到DIM图层 lisp程序
标注时自动切换到DIM图层
[code=lisp](defun xlr-autolayer ()
; (setvar "cmdecho" 0)
; (if (null (tblsearch "layer" "text"))
; (set_layer_list "text" 3 "continuous")
; )
; (if (null (tblsearch "layer" "dim"))
; (set_layer_list "dim" 3 "continuous")
; )
(vl-load-com)
;; 图层初始化列表 内容:commands layers color linetype plottable
(setq *doc (vla-get-activedocument (vlax-get-acad-object)))
(setq *lays (vla-get-layers *doc))
(setq *laylst
(list (list "DIMANGULAR" "DIM" 3 "continuous" T)
(list "DIMALIGNED" "DIM" 3 "continuous" T)
(list "DIMBASELINE" "DIM" 3 "continuous" T)
(list "DIMCENTER" "DIM" 3 "continuous" T)
(list "DIMCONTINUE" "DIM" 3 "continuous" T)
(list "DIMDIAMETER" "DIM" 3 "continuous" T)
(list "DIMLINEAR" "DIM" 3 "continuous" T)
(list "DIMORDINATE" "DIM" 3 "continuous" T)
(list "DIMRADIUS" "DIM" 3 "continuous" T)
(list "QDIM" "DIM" 3 "continuous" T)
(list "QLEADER" "DIM" 3 "continuous" T)
(list "DTEXT" "TEXT" 3 "continuous" T)
(list "MTEXT" "TEXT" 3 "continuous" T)
(list "TEXT" "TEXT" 3 "continuous" T)
;(list "BHATCH" "填充" 9 "continuous" T)
;(list "HATCH" "填充" 9 "continuous" T)
;(list "POINT" "点" 4 "continuous" T)
;(list "XLINE" "辅助线" 8 "continuous" T)
;(list "LINE" "0" NIL "continuous" T)
;(list "XREF" "引用" 7 "continuous" T)
;(list "pline" "多义线" 2 "center" T)
)
)
(setq OldLayer nil)
(setq *cmdlst (mapcar 'strcase (mapcar 'car *laylst)))
(mapcar '(lambda (x) (vlr-command-reactor nil x))
(list '((:vlr-commandWillStart . xlr-start))
'((:vlr-commandEnded . xlr-end))
'((:vlr-commandCancelled . xlr-cancel))
)
)
(vlr-editor-reactor
nil
'((:vlr-commandwillstart . xlr-edit))
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-edit (CALL CALLBACK /)
(foreach N *laylst
(if (= (strcase (car CALLBACK)) (strcase (car N)))
; 命令反应器返回信息如果与设置的命令相同.
(progn ;建立图层
(apply 'xsetlays (cdr N))
;(setvar "CLAYER" (cadr N));设为当前层.
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-start (calling-reactor xlr-startInfo /)
(foreach N *laylst
(if (= (strcase (car xlr-startInfo)) (strcase (car N)))
; 命令反应器返回信息如果与设置的命令相同.
(progn ;建立图层
(apply 'xsetlays (cdr N))
;(setvar "CLAYER" (cadr N));设为当前层.
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-end (calling-reactor xlr-endInfo / cmd)
(setq cmd (car xlr-endInfo))
(if (member cmd *cmdlst)
(if (/= oldlayer nil)
(progn
(setvar "CLAYER" OldLayer)
(setq OldLayer nil)
)
)
)
)
;;;----------------------------------------------------------------------------;;;
(defun xlr-cancel (calling-reactor xlr-cancelInfo / cmd)
(setq cmd (car xlr-cancelInfo))
(if (member cmd *cmdlst)
(if (/= oldlayer nil)
(progn
(setvar "CLAYER" OldLayer)
(setq OldLayer nil)
)
)
)
)
;;;----------------------------------------------------------------------------;;;
;;;----------------------------------------------------------------------------;;;
(defun xsetlays (LAY-NAM COLOR LTYPE plotk / LAYOBJ LTYPESOBJ)
(if (tblobjname "layer" LAY-NAM)
(progn
(if (/= (strcase (getvar "CLAYER"))
(strcase LAY-NAM)
)
(setq OldLayer (getvar "CLAYER"))
(progn
(if (= oldlayer nil)
(setq OldLayer LAY-NAM)
)
)
)
(setvar "CLAYER" lay-nam)
)
(progn ;添加图层.
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-add (list *lays LAY-NAM))
)
(setq LAYOBJ (vla-item *lays LAY-NAM))
(if (not (tblobjname "ltype" LTYPE)) ;添加线型.
(progn
(setq LTYPESOBJ (vla-get-linetypes *doc))
(vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
;>>> 要加强,在多个*.lin寻找
(vlax-release-object LTYPESOBJ)
)
) ;解冻(如冻结),解锁,设图层为当前,设图层颜色,可打印特性.
(vla-put-layeron layobj :vlax-true)
(vla-put-lock layobj :vlax-false)
(if (= (strcase (getvar "CLAYER")) (strcase lay-nam)) ;解冻.
(vla-put-freeze layobj :vlax-false)
)
(vla-put-color layobj color)
(vla-put-linetype layobj LTYPE)
(vla-put-plottable
layobj
(if plotk
:vlax-true
:vlax-false
)
)
)
)
)
(xlr-autolayer) ;加载启动!
(princ "\n ----命令图层反应器已加载----")
[/code]
lisp调用qleader端点_标注时自动切换到DIM图层 lisp程序相关推荐
- lisp调用qleader端点_常用函数.lsp - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
本帖最后由 自贡黄明儒 于 2013-11-11 12:57 编辑 ;;各位,把你们收藏都拿出秀一秀呀,放在箱底会生霉的 ;;我的收集是在caoyin发布的通用函数基础上扩展的----自贡黄明儒 20 ...
- lisp调用qleader端点_[分享]lisp中可用command调用的函数全集!!!!
[分享]lisp中可用command调用的函数全集!!!! [em21] [em16] lisp中command命令可以调用的函数全集: 3D 创建三维多边形网格对象 3DARRAY 创建三维阵列 3 ...
- lisp调用qleader端点_超经典【CAD】 lisp程序集锦、【CAD】快捷键大全(好).doc
超经典CAD lisp程序集锦 如果您使用 AutoCAD,下面的内容对您一定有帮助.在某些方面能大大提高 您的工作效率.下面的程序均以源程序方式给出,您可以使用.参考.修改它. bg.lsp 表格自 ...
- lisp获取qleader端点_中文版AutoCAD2013高手之道
中文版AutoCAD2013高手之道 1 AutoCAD快速入门 1.1 初步了解AutoCAD 2013 1.1.1 什么是 AutoCAD 1.1.2 AutoCAD 和 AutoCAD LT 的 ...
- lisp调用qleader端点_autolisp,Autolisp是一个什么程序啊?
Autolisp是一个什么程序啊? AutoLISP是由Autodesk公司开发的一种LISP程序语言(LISP是List Processor的缩写)http://www.88ve.cn/jixies ...
- lisp获取qleader端点_南方CASS和AutoCAD快捷命令大全
原标题:南方CASS和AutoCAD快捷命令大全 A--画弧(ARC) AA--给实体加地物名 B--自由连接 C--画圆(CIRCLE) COPYCLIP--从不同窗口复制局部 CP--拷贝(COP ...
- lisp调用qleader端点_CAD命令大全的.doc
CAD命令大全的 (一)字母类? 1.对象特性? ADC,?*ADCENTER(设计中心"Ctrl+2") CH,?MO?*PROPERTIES(修改特性"Ctrl+1& ...
- lisp获取qleader端点_基于AutoLISP的点坐标标注
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!! (10)造型完成 至此,完成了该变速器总成所有气管的三维造型. ...
- lisp调用qleader端点_CAD常用命令大全全解.doc
CAD常用命令大全全解 1.3darray 3a 三维阵列 2.3dclip 设置剪切平面位置 3.3dcorblt 继续执行3DORBIT命令 4.3DDISTANCE 距离调整 5.3DFACE ...
最新文章
- Linux正则表达式grep与egrep
- tmux远程服务器训练
- Sql server 获得某一部门下的所有子部门。根据子部门获得它的上级部门。
- 一分钟了解 Matlab求两个矩阵的相关程度corr2
- CMU算法新教材的获取方法
- 第三方app_为什么第三方APP不能下载呢?
- 将旧版本从Java EE 5减少到7
- c++ for each 遍历tuple
- 是哪个app_互联网app创业哪个比较好
- 手机运行内存6+128跟8+128有什么区别?
- 细说 ASP.NET控制HTTP缓存[转]
- php 如何生成txt文件,PHP生成TXT文件
- 信号与系统的基本概念与通信系统模型
- 基于web的博客系统的设计与实现
- 输入法变成繁体后改回简体中文
- 人工智能期末考试复习
- linux 64位 共享内存 创建失败,共享内存创建失败(已经存在)时如何获得已创建的共享内存?...
- 显卡虚拟化_跑分曝光:苹果M1 Mac运行虚拟化Win10速度快于Surface Pro X 2;联想官网上架拯救者 R9000X 笔记本...
- mysql upsert语法_Mysql - Upsert功能实现
- 智能优化与机器学习结合算法实现时序数据预测matlab代码清单
热门文章
- Duilib学习笔记《03》— 控件使用
- Handler和Message详解
- MYSQL中replace into的用法
- oracle em(Enterprise Manager) 收集贴
- opencv学习笔记(六)直方图比较图片相似度
- OpenCV3.2+VS2013+Tesseract3.02.02配置
- uni-app 实现小程序rsa加密(非对称加密原理)
- esxi服务器3d性能,ESXi主机性能问题(示例代码)
- 把combobox控件添加到datagridview控件中_自定义系列:控件属性添加
- linux ssh和scp,Linux SSH 与 SCP命令简述