LISP经典程序
CAD LISP 程序教学内容
C AD L I S P程序1.计算所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度) (defun c:LL ()(setvar "cmdecho" 1)(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))(setq i 0)(setq ll 0)(repeat (sslength en)(setq ss (ssname en i))(setq endata (entget ss))(command "lengthen" ss "")(setq dd (getvar "perimeter"))(setq ll (+ dd ll))(setq i (1+ i)))(princ "所选线条总长为：")(princ ll)(princ))2.标注所有线段(加载后只需框选所有线段便可得标注这些线段)(defun c:LLL ()(COMMAND "UCS" "")(setvar "cmdecho" 1)(SETVAR "OSMODE" 0)(setq AcadObject (vlax-get-acad-object)AcadDocument (vla-get-ActiveDocument Acadobject)mSpace (vla-get-ModelSpace Acaddocument));;选取需要测量的样条曲线、圆弧、直线、椭圆(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE")))) (setq i 0);;获取系统参数textsize(setq shh (getvar "textsize"))(setq str_hh (strcat "\n文字高度<" (rtos shh 2) ">: "))(setq hh (getdist str_hh))(while hh(setvar "textsize" hh)(setq hh nil));;输入标注文字高度;;循环开始(repeat (sslength en)(setq ss (ssname en i))(setq endata (entget ss))(command "lengthen" ss "")(setq dd (getvar "perimeter"))(princ (strcat "\n长度=" (rtos dd 2)));;寻找代表图层的字符串(setq aa (assoc 0 endata));;获取图层名称(setq aa1 (cdr aa));;判断线条种类(cond((= aa1 "SPLINE");;如果是spline(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss)) (setq startPnt1 (vla-get-ControlPoints arcObj))(setq p1(vlax-safearray->list (vlax-variant-value startPnt1)) )(setq x1 (car p1))(setq y1 (cadr p1))(setq z1 (caddr p1))(setq pp1 (list x1 y1 z1))(repeat (- (/ (length p1) 3) 1);;循环，寻找最后一个控制点(setq p1 (cdddr p1))(setq x2 (car p1))(setq y2 (cadr p1))(setq z2 (caddr p1)))(setq pp2 (list x2 y2 z2))))((= aa1 "LWPOLYLINE");;如果是LWPOLYLINE(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss)) (setq startPnt1 (vla-get-Coordinates arcObj))(setq p1(vlax-safearray->list (vlax-variant-value startPnt1)) )(setq x1 (car p1))(setq y1 (cadr p1))(setq z1 (caddr p1))(setq pp1 (list x1 y1 z1))(repeat (- (/ (length p1) 3) 1);;循环，寻找最后一个控制点(setq p1 (cdddr p1))(setq x2 (car p1))(setq y2 (cadr p1))(setq z2 (caddr p1)))(setq pp2 (list x2 y2 z2))))(t;;如果是其他种类线条(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))(setq startPnt1 (vla-get-StartPoint arcObj));;获取起点(setq endPnt1 (vla-get-EndPoint arcObj));;获取终点(setq pp1(vlax-safearray->list (vlax-variant-value startPnt1)))(setqpp2 (vlax-safearray->list (vlax-variant-value endPnt1)) ))))(setq x1 (car pp1))(setq y1 (cadr pp1))(setq z1 (caddr pp1))(setq x2 (car pp2))(setq y2 (cadr pp2))(setq z2 (caddr pp2))(setq x (/ (+ x1 x2) 2))(setq y (/ (+ y1 y2) 2))(setq z (/ (+ z1 z2) 2))(setq pt (list x y z));;取得线段两端的中点(setq ang (angle pp1 pp2));;获取角度(if (> (* (/ ang pi) 180) 180) (setq ang (+ ang pi)))(command "text""j""bc"pt""(* (/ ang pi) 180)(strcat "" (rtos dd 2))"")(setq i (1+ i)))(prin1))(prompt "\n <>在图中直接写出长度") (prin1)3.连续打断程序(defun c:br1 ()(command "break" pause "f" pause "@") )4.将CAD文字导入Excel表格(defun c:Q2()(setq ffn (getfiled "写出文件" "" "xls" 1))(princ "\n选取文字...")(setq ss (ssget))(setq ff (open ffn "w"))(setq i 0)(repeat (sslength ss)(setq ssn (ssname ss i))(setq ssdata (entget ssn))(setq sstyp (cdr (assoc 0 ssdata)))(if (or (= sstyp "TEXT") (= sstyp "MTEXT")) (progn(setq txt (cdr (assoc 1 ssdata)))(princ txt ff)(princ "\n" ff)))(setq i (1+ i)))(close ff)(princ (strcat "\n写出文件: " ffn))(prin1))5删除带颜色图元以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次. 改颜色的LISP程序(defun c:c1()(ssget)(command "chprop" "p" "" "c" "1" "") (princ)) (defun c:c2()(ssget)(command "chprop" "p" "" "c" "2" "") (princ)) (defun c:c3()(ssget)(command "chprop" "p" "" "c" "3" "") (princ)) (defun c:c4()(ssget)(command "chprop" "p" "" "c" "4" "") (princ)) (defun c:c5()(ssget)(command "chprop" "p" "" "c" "5" "") (princ)) (defun c:c6()(ssget)(command "chprop" "p" "" "c" "6" "") (princ)) (defun c:c7()(ssget)(command "chprop" "p" "" "c" "7" "") (princ)) (defun c:c8()(ssget)(command "chprop" "p" "" "c" "8" "") (princ))你用C1 命令就可以将图元改为红色了.其余类似.删除红色图元(defun C:D1 (/ m A M)(setq m:err *error* *error* *merr*)(setvar "cmdecho" 0)(command "UNDO" "G")(prompt "选择图形")(setq A (ssget '((62 . 1)) ))(if (/= A nil)(progn(setq M (sslength A))(command "erase" A "")(princ "\n共删除红色图元<")(princ M)(princ ">个") ))(command "UNDO" "E")(princ) )这样,键入 D1 命令,就可以删除红色的图元了.。
超经典CAD lisp程序集锦、CAD快捷键大全
超经典CAD lisp程序集锦如果您使用 AutoCAD,下面的内容对您一定有帮助。
在某些方面能大大提高您的工作效率。
下面的程序均以源程序方式给出，您可以使用、参考、修改它。
bg.lsp --- 表格自动生成asc.lsp --- 将文本文件内容写入图中，字符是单个的wf.lsp --- 将图中字符写入磁盘exstr.lsp --- 将字符串分解成单字pgtxt.lsp --- 将字符合成字符串pb.lsp --- 通过给出长度将字符串分成两个串cht.lsp --- 直接修改文字内容或块属性ct.lsp --- 对数字串进行加减chh.lsp --- 直接修改文字高度chhw.lsp --- 直接修改文字高宽比(针对PKPM软件将字符定位点改为左下角) chst.lsp --- 直接修改文字字体txt.shx --- 修改后的标准txt.shx文件。
(kuozhan.sld为增强的内容幻灯片)tiao.lsp --- 配合修改过的标准字体文件，将中文字符调大tiao1.lsp --- 配合修改过的标准字体文件，将英文字符调小untiao.lsp --- 上两个程序的复原sht.lsp --- 在图中查找字符串zhuang.lsp --- 桩点及钎探号绘制（勘测图）dim.lsp --- 配合JT.DWG将尺寸标注调成适合建筑结构设计(1:1)dimm.lsp --- 配合JT.DWG将尺寸标注调成适合建筑结构设计(1:100)di1.lsp～di8.lsp --- 直接连续标注尺寸(用于1:1的图)di100.lsp～di800.lsp --- 直接连续标注尺寸(用于1:100的图)详细内容及附件下载请浏览北纬服务论坛/thread-2724-1-1.htmlCAD快捷键大全F1: 获取帮助F2: 实现作图窗和文本窗口的切换F3: 控制是否实现对象自动捕捉F4: 数字化仪控制F5: 等轴测平面切换F6: 控制状态行上坐标的显示方式F7: 栅格显示模式控制F8: 正交模式控制F9: 栅格捕捉模式控制F10: 极轴模式控制F11: 对象追踪式控制Ctrl+B: 栅格捕捉模式控制(F9)刚刚看了一下dra:半径标注ddi:直径标注dal:对齐标注dan:角度标注Ctrl+C: 将选择的对象复制到剪切板上Ctrl+F: 控制是否实现对象自动捕捉(f3) Ctrl+G: 栅格显示模式控制(F7)Ctrl+J: 重复执行上一步命令Ctrl+K: 超级链接Ctrl+N: 新建图形文件Ctrl+M: 打开选项对话框AA: 测量区域和周长(area)AL: 对齐(align)AR: 阵列(array)AP: 加载*lsp程系AV: 打开视图对话框(dsviewer) SE: 打开对相自动捕捉对话框ST: 打开字体设置对话框(style) SO: 绘制二围面( 2d solid) SP: 拼音的校核(spell)SC: 缩放比例 (scale)SN: 栅格捕捉模式设置(snap) DT: 文本的设置(dtext)DI: 测量两点间的距离OI：插入外部对相Ctrl+1: 打开特性对话框Ctrl+2: 打开图象资源管理器Ctrl+6: 打开图象数据原子Ctrl+O: 打开图象文件Ctrl+P: 打开打印对说框Ctrl+S: 保存文件Ctrl+U: 极轴模式控制(F10)Ctrl+v: 粘贴剪贴板上的内容Ctrl+W: 对象追踪式控制(F11) Ctrl+X: 剪切所选择的内容Ctrl+Y: 重做Ctrl+Z: 取消前一步的操作A: 绘圆弧B: 定义块C: 画圆D: 尺寸资源管理器E: 删除F: 倒圆角G: 对相组合H: 填充I: 插入S: 拉伸T: 文本输入W: 定义块并保存到硬盘中L: 直线M: 移动X: 炸开V: 设置当前坐标U: 恢复上一次操做O: 偏移P: 移动Z: 缩放显示降级适配（开关）【O】适应透视图格点【Shift】+【Ctrl】+【A】排列【Alt】+【A】角度捕捉(开关) 【A】动画模式 (开关) 【N】改变到后视图【K】背景锁定(开关) 【Alt】+【Ctrl】+【B】前一时间单位【.】下一时间单位【,】改变到上（Top）视图【T】改变到底(Bottom)视图【B】改变到相机(Camera)视图【C】改变到前（Front）视图【F】改变到等大的用户(User)视图【U】改变到右(Right)视图【R】改变到透视（Perspective）图【P】循环改变选择方式【Ctrl】+【F】默认灯光(开关) 【Ctrl】+【L】删除物体【DEL】当前视图暂时失效【D】是否显示几何体内框(开关) 【Ctrl】+【E】显示第一个工具条【Alt】+【1】专家模式�全屏(开关) 【Ctrl】+【X】暂存(Hold)场景【Alt】+【Ctrl】+【H】取回(Fetch)场景【Alt】+【Ctrl】+【F】冻结所选物体【6】跳到最后一帧【END】跳到第一帧【HOME】显示/隐藏相机（Cameras）【Shift】+【C】显示/隐藏几何体(Geometry) 【Shift】+【O】显示/隐藏网格(Grids) 【G】显示/隐藏帮助(Helpers)物体【Shift】+【H】显示/隐藏光源(Lights) 【Shift】+【L】显示/隐藏粒子系统(Particle Systems) 【Shift】+【P】显示/隐藏空间扭曲(Space Warps)物体【Shift】+【W】锁定用户界面(开关) 【Alt】+【0】匹配到相机(Camera)视图【Ctrl】+【C】材质(Material)编辑器【M】最大化当前视图 (开关) 【W】脚本编辑器【F11】新的场景【Ctrl】+【N】法线(Normal)对齐【Alt】+【N】向下轻推网格小键盘【-】向上轻推网格小键盘【+】NURBS表面显示方式【Alt】+【L】或【Ctrl】+【4】NURBS调整方格1 【Ctrl】+【1】NURBS调整方格2 【Ctrl】+【2】NURBS调整方格3 【Ctrl】+【3】偏移捕捉【Alt】+【Ctrl】+【空格】打开一个MAX文件【Ctrl】+【O】平移视图【Ctrl】+【P】交互式平移视图【I】放置高光(Highlight) 【Ctrl】+【H】播放/停止动画【/】快速(Quick)渲染【Shift】+【Q】回到上一场景*作【Ctrl】+【A】回到上一视图*作【Shift】+【A】撤消场景*作【Ctrl】+【Z】撤消视图*作【Shift】+【Z】刷新所有视图【1】用前一次的参数进行渲染【Shift】+【E】或【F9】渲染配置【Shift】+【R】或【F10】在xy/yz/zx锁定中循环改变【F8】约束到X轴【F5】约束到Y轴【F6】约束到Z轴【F7】旋转(Rotate)视图模式【Ctrl】+【R】或【V】保存(Save)文件【Ctrl】+【S】透明显示所选物体(开关) 【Alt】+【X】选择父物体【PageUp】选择子物体【PageDown】根据名称选择物体【H】选择锁定(开关) 【空格】减淡所选物体的面(开关) 【F2】显示所有视图网格(Grids)(开关) 【Shift】+【G】显示/隐藏命令面板【3】显示/隐藏浮动工具条【4】显示最后一次渲染的图画【Ctrl】+【I】显示/隐藏主要工具栏【Alt】+【6】显示/隐藏安全框【Shift】+【F】*显示/隐藏所选物体的支架【J】显示/隐藏工具条【Y】/【2】百分比(Percent)捕捉(开关) 【Shift】+【Ctrl】+【P】打开/关闭捕捉(Snap) 【S】循环通过捕捉点【Alt】+【空格】声音(开关) 【\】间隔放置物体【Shift】+【I】改变到光线视图【Shift】+【4】循环改变子物体层级【Ins】子物体选择(开关) 【Ctrl】+【B】帖图材质(Texture)修正【Ctrl】+【T】加大动态坐标【+】减小动态坐标【-】激活动态坐标(开关) 【X】精确输入转变量【F12】全部解冻【7】根据名字显示隐藏的物体【5】刷新背景图像(Background) 【Alt】+【Shift】+【Ctrl】+【B】显示几何体外框(开关) 【F4】视图背景(Background) 【Alt】+【B】用方框(Box)快显几何体(开关) 【Shift】+【B】打开虚拟现实数字键盘【1】虚拟视图向下移动数字键盘【2】虚拟视图向左移动数字键盘【4】虚拟视图向右移动数字键盘【6】虚拟视图向中移动数字键盘【8】虚拟视图放大数字键盘【7】虚拟视图缩小数字键盘【9】实色显示场景中的几何体(开关) 【F3】全部视图显示所有物体【Shift】+【Ctrl】+【Z】*视窗缩放到选择物体范围（Extents）【E】缩放范围【Alt】+【Ctrl】+【Z】视窗放大两倍【Shift】+数字键盘【+】放大镜工具【Z】视窗缩小两倍【Shift】+数字键盘【-】根据框选进行放大【Ctrl】+【w】视窗交互式放大【[】视窗交互式缩小【]】轨迹视图加入(Add)关键帧【A】前一时间单位【<】下一时间单位【>】编辑(Edit)关键帧模式【E】编辑区域模式【F3】编辑时间模式【F2】展开对象（Object）切换【O】展开轨迹（Track）切换【T】函数(Function)曲线模式【F5】或【F】锁定所选物体【空格】向上移动高亮显示【↓】向下移动高亮显示【↑】向左轻移关键帧【←】向右轻移关键帧【→】位置区域模式【F4】回到上一场景*作【Ctrl】+【A】撤消场景*作【Ctrl】+【Z】用前一次的配置进行渲染【F9】渲染配置【F10】向下收拢【Ctrl】+【↓】向上收拢【Ctrl】+【↑】材质编辑器用前一次的配置进行渲染【F9】渲染配置【F10】撤消场景*作【Ctrl】+【Z】示意(Schematic)视图下一时间单位【>】前一时间单位【<】回到上一场景*作【Ctrl】+【A】撤消场景*作【Ctrl】+【Z】Active Shade绘制(Draw)区域【D】渲染(Render) 【R】锁定工具栏(泊坞窗) 【空格】视频编辑加入过滤器(Filter)项目【Ctrl】+【F】加入输入(Input)项目【Ctrl】+【I】加入图层(Layer)项目【Ctrl】+【L】加入输出(Output)项目【Ctrl】+【O】加入(Add)新的项目【Ctrl】+【A】加入场景(Scene)事件【Ctrl】+【s】编辑(Edit)当前事件【Ctrl】+【E】执行(Run)序列【Ctrl】+【R】新(New)的序列【Ctrl】+【N】撤消场景*作【Ctrl】+【Z】NURBS编辑CV 约束法线(Normal)移动【Alt】+【N】CV 约束到U向移动【Alt】+【U】CV 约束到V向移动【Alt】+【V】显示曲线(Curves) 【Shift】+【Ctrl】+【C】显示控制点(Dependents) 【Ctrl】+【D】显示格子(Lattices) 【Ctrl】+【L】NURBS面显示方式切换【Alt】+【L】显示表面(Surfaces) 【Shift】+【Ctrl】+【s】显示工具箱(Toolbox) 【Ctrl】+【T】显示表面整齐(Trims) 【Shift】+【Ctrl】+【T】根据名字选择本物体的子层级【Ctrl】+【H】锁定2D 所选物体【空格】选择U向的下一点【Ctrl】+【→】选择V向的下一点【Ctrl】+【↑】选择U向的前一点【Ctrl】+【←】选择V向的前一点【Ctrl】+【↓】根据名字选择子物体【H】柔软所选物体【Ctrl】+【s】转换到Curve CV 层级【Alt】+【Shift】+【Z】转换到Curve 层级【Alt】+【Shift】+【C】转换到Imports 层级【Alt】+【Shift】+【I】转换到Point 层级【Alt】+【Shift】+【P】转换到Surface CV 层级【Alt】+【Shift】+【V】转换到Surface 层级【Alt】+【Shift】+【S】转换到上一层级【Alt】+【Shift】+【T】转换降级【Ctrl】+【X】FFD转换到控制点(Control Point)层级【Alt】+【Shift】+【C】到格点(Lattice)层级【Alt】+【Shift】+【L】到设置体积(Volume)层级【Alt】+【Shift】+【S】转换到上层级【Alt】+【Shift】+【T】打开的UVW贴图进入编辑(Edit)UVW模式【Ctrl】+【E】调用*.uvw文件【Alt】+【Shift】+【Ctrl】+【L】保存UVW为*.uvw格式的文件【Alt】+【Shift】+【Ctrl】+【S】打断(Break)选择点【Ctrl】+【B】分离(Detach)边界点【Ctrl】+【D】过滤选择面【Ctrl】+【空格】水平翻转【Alt】+【Shift】+【Ctrl】+【B】垂直(Vertical)翻转【Alt】+【Shift】+【Ctrl】+【V】冻结(Freeze)所选材质点【Ctrl】+【F】隐藏(Hide)所选材质点【Ctrl】+【H】全部解冻(unFreeze) 【Alt】+【F】全部取消隐藏(unHide) 【Alt】+【H】从堆栈中获取面选集【Alt】+【Shift】+【Ctrl】+【F】从面获取选集【Alt】+【Shift】+【Ctrl】+【V】锁定所选顶点【空格】水平镜象【Alt】+【Shift】+【Ctrl】+【N】垂直镜象【Alt】+【Shift】+【Ctrl】+【M】水平移动【Alt】+【Shift】+【Ctrl】+【J】垂直移动【Alt】+【Shift】+【Ctrl】+【K】平移视图【Ctrl】+【P】象素捕捉【S】平面贴图面/重设UVW 【Alt】+【Shift】+【Ctrl】+【R】水平缩放【Alt】+【Shift】+【Ctrl】+【I】垂直缩放【Alt】+【Shift】+【Ctrl】+【O】移动材质点【Q】旋转材质点【W】等比例缩放材质点【E】焊接(Weld)所选的材质点【Alt】+【Ctrl】+【W】焊接(Weld)到目标材质点【Ctrl】+【W】Unwrap的选项(Options) 【Ctrl】+【O】更新贴图(Map) 【Alt】+【Shift】+【Ctrl】+【M】将Unwrap视图扩展到全部显示【Alt】+【Ctrl】+【Z】框选放大Unwrap视图【Ctrl】+【Z】将Unwrap视图扩展到所选材质点的大小【Alt】+【Shift】+【Ctrl】+【Z】缩放到Gizmo大小【Shift】+【空格】缩放(Zoom)工具【Z】反应堆(Reactor)建立(Create)反应(Reaction) 【Alt】+【Ctrl】+【C】删除(Delete)反应(Reaction) 【Alt】+【Ctrl】+【D】编辑状态(State)切换【Alt】+【Ctrl】+【s】设置最大影响(Influence) 【Ctrl】+【I】设置最小影响(Influence) 【Alt】+【I】设置影响值(Value) 【Alt】+【Ctrl】+【V】ActiveShade (Scanline)初始化【P】更新【U】宏编辑器累积计数器【Q】[color=#800080]AutoCAD快捷键快捷键执行命令命令说明3A 3DARRAY 三维阵列3DO 3DORBIT 三维动态观察器3F 3DFACE 三维表面3P 3DPOLY 三维多义线A ARC 圆弧ADC ADCENTER AutoCAD设计设计中心AA AREA 面积AL ALIGN 对齐（适用于二维和三维）AP APPLOAD 加载、卸载应用程序AR ARRAY 阵列*AR *ARRAY 命令式阵列ATT ATTDEF 块的属性*ATT *ATTDEF 命令式块的属性ATE ATTEDIT 编辑属性ATE *ATTEDIT 命令式编辑属性ATTE *ATTEDIT 命令式编辑属性B BLOCK 对话框式图块建立*B *BLOCK 命令式图块建立BH BHATCH 对话框式绘制图案填充BO BOUNDARY 对话框式封闭边界建立*BO *BOUNDARY 命令式封闭边界建立BR BREAK 打断C CIRCLE 圆CHA PROPERTIES 对话框式对象特情修改*CH CHANGE 命令式特性修改CHA CHAMFER 倒角COL COLCR 对话框式颜色设定COLOUR COLCR 对话框式颜色设定CO COPY 复制D DIMSTYLE 尺寸样式设定DAL DIMALIGNED 对齐式线性标注DAN DIMANGULAR 角度标注DBA DIMBASELINE 基线式标注DBC DBCONNECT 提供到外部数据库表的接口DCE DIMCENTER 圆心标记DCO DIMCONTINUE 连续式标注DDA DIMDISASSOCIATE 标注不关联DDI DIMDIAMETER 直径标注DED DIMEDIT 尺寸修改DI DIST 测量两点间距离DIV DIVIDE 等分布点DLI DIMLINEAR 线性标注DO DONUT 双圆DOR DIMORDIMATE 坐标式标注DOV DIMOVERRIDE 更新标注变量DR DRAWORDER 显示顺序DRA DIMRADIUS 半径标注DRE DIMREASSOCIATE 标注关联DS DSETTINGS 捕捉设定DST DIMSTYLE 尺寸样式设定DT DTEXT 写入文字DV DVIEW 定义平行投影或透视投影视图E ERASE 删除对象ED DDEDIT 单行文字修改EL ELLIPSE 椭圆EX EXTEND 延伸EXIT QUIT 退出EXP EXPORT 输出文件EXT EXTRUDE 将二维对象拉伸为三、维维实体F FILLET 倒圆角FI FILTER 过滤器G GROUP 对话框式选择集设定*G *GROUP 命令式选择集设定GR DDGRIPS 夹点控制设定H BHATCH 对话框式绘制图案填充*H HATCH 命令式绘制图案填充HE HATCHEDIT 编辑图案填充HI HIDE 消隐I INSERT 对话框式插入图块*I *INSERT 命令式插入图块IAD IMAGEADJUST 图像调整IAT IMAGEATTACH 并入图像ICL IMAGECLIP 截取图像IM IMAGE 对话框式附着图像*IM *IMAGE 命令式贴附图像IMP IMPORT 输入文件IN INTERSECT 将相交实体或面域部分创建INF IMTERFERE 由共同部分创建三维实体IO INSERTOBJ 插入对象L LINE 画线LA LAYER 对话框式图层控制*LA *LAYER 命令式图层控制LE QLEADER 引导线标注LRN LENGTHEN 长度LI LIST 查询对象文件LINEWEIGHT LWEIGHT 线宽LO *LAYOUT 配置设定LS LIST 查询对象文件LT LINETYPE 对话框式线型加载*LT *LINETYPE 命令式线型加载LTYPE LINETYPE 对话框式线型加载*LTYPE *LINETYPE 命令式线型加载LTS LTSCALE 设置线型比例因子LW LWEIGHT 线宽设定M MOVE 搬移对象MA MATCHPROP 对象特性复制ME MEASURE 量测等距布点MI MIRROR 镜像对象ML MLINE 绘制多线MO PROPERTIES 对象特性修改MS MSPACE 从图纸空间转换支模型空间MT MTEXT 多行文字写入MV MVIEW 浮动视口O OFFSET 偏移复制OP POPTIONS 选项ORBIT 3DORBIT 三维动态观察器OS OSNAP 对话框式对象捕捉设定*OS *OSNAP 命令式对象捕捉设定P PAN 即时平移*P *PAN 两点式平移控制PA PASTESPEC 选择性粘贴PARTIALOPEN *PASTESPEC 将指定的对象加载对新图形中PE PEDIT 编辑多义线PL PLINE 绘制多义线PO POINT 绘制点POL POLYGON 绘制正多边型PR OPTIONS 选项PRCLOSE PROPERTIESCLOSE 关闭对象特性修改对话框PROPS PROPERTIES 对象特性修改PRE PREVIEW 输出预览PRINT PLOT 打印输出PS PSPACE 图线空间PTW PUBLISHTIWEB 发送支网页PU PURGE 肃清无用对象*PU *PURGE 命令式肃清无用对象R REDRAW 重绘RA REDRAWALL 所有视口重绘RE REGEN 重新生成REA REGENALL 所有视口重新生成REC RECTANGLE 绘制矩形REG REGION 三维面域REN REBAME 对话框式重命名*REN *REBAME 命令式重命名REV REVOLVE 利用绕轴旋转二维对象创建三维体RM DDRMODES 打印辅助设定RO ROTATE 旋转RPR RPREF 设置渲染参考RR RENDER 渲染S STRETCH 拉伸SC SCALE 比例缩放SCR SCRIPT 调入剧本文件SE DSETTINGS 捕捉设定SEC DECTION 通过使平面与实体相交创建面域SET SETVAR 设定变量值SHA SHADE 着色SL SLICE 用平面剖切实体SN SNAP 捕捉控制SO SOLID 填实的三边形或四边形SP SEELL 拼字SPL SPLINE 样条曲线SPE SPLINEDIT 编辑样条曲线ST STYLE 字型设定SU SUBTRACT 差集运算T MTEXT 对话框式多行文字写入*T *MTEXT 命令式多行文字写入TA TABLET 数字化仪规划TH THICKNESS 厚度TI TILEMODE 图线空间和模型空间设定切换TO TOOLBAR 工具栏设定TOL TOLERANCE 公差符号标注TOR TORUS 圆环TR TRIM 修剪UC DDUCS 用户坐标系UCP DDUCSP 设置正交窗口UN UNITS 对话框式单位设定*UN *UNITS 命令式单位设定UNI UNION 并集运算V VIEW 对话框式视图控制*V *VIEW 视图控制VP DDVPOPINT 视点*VP WPOINT 命令式视点W WBLOCK 对话框式图块写出*W *WBLOCK 命令式图块写出WE WEDGE 三维楔体X EXPLODE 分解XA XATTACH 贴附外部参考XB XBIND 并入外部参考*XB *XBIND 命令式并入外部参考XC XCLIP 截取外部参考XL XLINE 构造线XR XREF 对话框式外部参考控制*XR *XREF 命令式外部参考控制Z ZOOM 视口缩入控制CTRL+A 编组CTRL+B 捕捉CTRL+C 复制CTRL+D 坐标CTRL+E 等轴测平面CTRL+F 对象捕捉CTRL+G 删格CTRL+J CTRL+SHIFT+S 图形另存为CTRL+K 超级链接LCTRL+L 正交CTRL+M 帮助CTRL+N 新建CTRL+O 打开CTRL+P 打印CTRL+Q 退出CTRL+S 保存CTRL+T 数字化仪CTRL+U CTRL+F10 极轴CTRL+V 粘贴CTRL+W 对象跟踪CTRL+X 剪切CTRL+z 退回CTRL+1 对象特性CTRL+2 CAD设计中心CTRL+6 数据源CTRL+F6 切换当前窗口CTRL+F8 运行部件CTRL+SHIFT+C 带基点复制快捷键执行命令命令说明3A 3DARRAY 三维阵列3DO 3DORBIT 三维动态观察器3F 3DFACE 三维表面3P 3DPOLY 三维多义线A ARC 圆弧ADC ADCENTER AutoCAD设计设计中心AA AREA 面积AL ALIGN 对齐（适用于二维和三维）AP APPLOAD 加载、卸载应用程序AR ARRAY 阵列*AR *ARRAY 命令式阵列ATT ATTDEF 块的属性*ATT *ATTDEF 命令式块的属性ATE ATTEDIT 编辑属性ATE *ATTEDIT 命令式编辑属性ATTE *ATTEDIT 命令式编辑属性B BLOCK 对话框式图块建立*B *BLOCK 命令式图块建立BH BHATCH 对话框式绘制图案填充BO BOUNDARY 对话框式封闭边界建立*BO *BOUNDARY 命令式封闭边界建立BR BREAK 打断C CIRCLE 圆CHA PROPERTIES 对话框式对象特情修改*CH CHANGE 命令式特性修改CHA CHAMFER 倒角COL COLCR 对话框式颜色设定COLOUR COLCR 对话框式颜色设定CO COPY 复制D DIMSTYLE 尺寸样式设定DAL DIMALIGNED 对齐式线性标注DAN DIMANGULAR 角度标注DBA DIMBASELINE 基线式标注DBC DBCONNECT 提供到外部数据库表的接口DCE DIMCENTER 圆心标记DCO DIMCONTINUE 连续式标注DDA DIMDISASSOCIATE 标注不关联DDI DIMDIAMETER 直径标注DED DIMEDIT 尺寸修改DI DIST 测量两点间距离DIV DIVIDE 等分布点DLI DIMLINEAR 线性标注DO DONUT 双圆DOR DIMORDIMATE 坐标式标注DOV DIMOVERRIDE 更新标注变量DR DRAWORDER 显示顺序DRA DIMRADIUS 半径标注DRE DIMREASSOCIATE 标注关联DS DSETTINGS 捕捉设定DST DIMSTYLE 尺寸样式设定DT DTEXT 写入文字DV DVIEW 定义平行投影或透视投影视图E ERASE 删除对象ED DDEDIT 单行文字修改EL ELLIPSE 椭圆EX EXTEND 延伸EXIT QUIT 退出EXP EXPORT 输出文件EXT EXTRUDE 将二维对象拉伸为三、维F FILLET 倒圆角FI FILTER 过滤器G GROUP 对话框式选择集设定*G *GROUP 命令式选择集设定GR DDGRIPS 夹点控制设定H BHATCH 对话框式绘制图案填充*H HATCH 命令式绘制图案填充HE HATCHEDIT 编辑图案填充HI HIDE 消隐I INSERT 对话框式插入图块*I *INSERT 命令式插入图块IAD IMAGEADJUST 图像调整IAT IMAGEATTACH 并入图像ICL IMAGECLIP 截取图像IM IMAGE 对话框式附着图像*IM *IMAGE 命令式贴附图像IMP IMPORT 输入文件IN INTERSECT 将相交实体或面域部分创建INF IMTERFERE 由共同部分创建三维实体IO INSERTOBJ 插入对象L LINE 画线LA LAYER 对话框式图层控制*LA *LAYER 命令式图层控制LE QLEADER 引导线标注LRN LENGTHEN 长度LI LIST 查询对象文件LINEWEIGHT LWEIGHT 线宽LO *LAYOUT 配置设定LS LIST 查询对象文件LT LINETYPE 对话框式线型加载*LT *LINETYPE 命令式线型加载LTYPE LINETYPE 对话框式线型加载*LTYPE *LINETYPE 命令式线型加载LTS LTSCALE 设置线型比例因子LW LWEIGHT 线宽设定M MOVE 搬移对象MA MATCHPROP 对象特性复制ME MEASURE 量测等距布点MI MIRROR 镜像对象ML MLINE 绘制多线MO PROPERTIES 对象特性修改MS MSPACE 从图纸空间转换支模型空间MT MTEXT 多行文字写入MV MVIEW 浮动视口O OFFSET 偏移复制OP POPTIONS 选项ORBIT 3DORBIT 三维动态观察器OS OSNAP 对话框式对象捕捉设定*OS *OSNAP 命令式对象捕捉设定P PAN 即时平移*P *PAN 两点式平移控制PA PASTESPEC 选择性粘贴PARTIALOPEN *PASTESPEC 将指定的对象加载对新图形中PE PEDIT 编辑多义线PL PLINE 绘制多义线PO POINT 绘制点POL POLYGON 绘制正多边型PR OPTIONS 选项PRCLOSE PROPERTIESCLOSE 关闭对象特性修改对话框PROPS PROPERTIES 对象特性修改PRE PREVIEW 输出预览PRINT PLOT 打印输出PS PSPACE 图线空间PTW PUBLISHTIWEB 发送支网页PU PURGE 肃清无用对象*PU *PURGE 命令式肃清无用对象R REDRAW 重绘RA REDRAWALL 所有视口重绘RE REGEN 重新生成REA REGENALL 所有视口重新生成REC RECTANGLE 绘制矩形REG REGION 三维面域REN REBAME 对话框式重命名*REN *REBAME 命令式重命名REV REVOLVE 利用绕轴旋转二维对象创建三维体RM DDRMODES 打印辅助设定RO ROTATE 旋转RPR RPREF 设置渲染参考RR RENDER 渲染S STRETCH 拉伸SC SCALE 比例缩放SCR SCRIPT 调入剧本文件SE DSETTINGS 捕捉设定SEC DECTION 通过使平面与实体相交创建面域SET SETVAR 设定变量值SHA SHADE 着色SL SLICE 用平面剖切实体SN SNAP 捕捉控制SO SOLID 填实的三边形或四边形SP SEELL 拼字SPL SPLINE 样条曲线SPE SPLINEDIT 编辑样条曲线ST STYLE 字型设定SU SUBTRACT 差集运算T MTEXT 对话框式多行文字写入*T *MTEXT 命令式多行文字写入TA TABLET 数字化仪规划TH THICKNESS 厚度TI TILEMODE 图线空间和模型空间设定切换TO TOOLBAR 工具栏设定TOL TOLERANCE 公差符号标注TOR TORUS 圆环TR TRIM 修剪UC DDUCS 用户坐标系UCP DDUCSP 设置正交窗口UN UNITS 对话框式单位设定*UN *UNITS 命令式单位设定UNI UNION 并集运算V VIEW 对话框式视图控制*V *VIEW 视图控制VP DDVPOPINT 视点*VP WPOINT 命令式视点W WBLOCK 对话框式图块写出*W *WBLOCK 命令式图块写出WE WEDGE 三维楔体X EXPLODE 分解XA XATTACH 贴附外部参考XB XBIND 并入外部参考*XB *XBIND 命令式并入外部参考XC XCLIP 截取外部参考XL XLINE 构造线XR XREF 对话框式外部参考控制*XR *XREF 命令式外部参考控制Z ZOOM 视口缩入控制CTRL+A 编组CTRL+B 捕捉CTRL+C 复制CTRL+D 坐标CTRL+E 等轴测平面CTRL+F 对象捕捉CTRL+G 删格CTRL+J CTRL+SHIFT+S 图形另存为CTRL+K 超级链接LCTRL+L 正交CTRL+M 帮助CTRL+N 新建CTRL+O 打开CTRL+P 打印CTRL+Q 退出CTRL+S 保存CTRL+T 数字化仪CTRL+U CTRL+F10 极轴CTRL+V 粘贴CTRL+W 对象跟踪CTRL+X 剪切CTRL+z 退回CTRL+1 对象特性CTRL+2 CAD设计中心CTRL+6 数据源CTRL+F6 切换当前窗口CTRL+F8 运行部件CTRL+SHIFT+C c 带基点复制。
LISP分形程序
Lisp分形程序一些用lisp语言书写的典型分形程序，可以任意修改相关参数；并配有详细文字注释，便于借鉴参考，从而自己书写新的程序。
这些程序要在CAD中加载运行，程序为纯文本格式，将文本复制到CAD中的Visual Lisp编辑器中加载运行即可。
以下是部分示例图片：1.分形三角2.分形树3.分形螺旋线程序1：(defun C:FX3(/);;;分形三角加速版(defun SJX(ptx1rx nx/);;;函数开始(setq ptx2(polar ptx1(/pi2)(/rx2)))(if(=nx0)(command"polygon"3ptx1"I"rx)(progn(SJX ptx2(/rx2)(1-nx));;;递归调用(SJX(polar ptx1(/(*pi7)6)(/rx2))(/rx2)(1-nx)) (SJX(polar ptx1(/(*pi11)6)(/rx2))(/rx2)(1-nx)) )));;;函数结束(setvar"OSMODE"37)(setq pt1(getpoint"中心点"))(setq r(getreal"外接圆半径"))(setq n(getint"层数")) (setvar"OSMODE"0)(SJX pt1r n) (setvar"OSMODE"37)(command))程序2：(defun C:FXS();;;分形树(setvar"OSMODE"37)(setq pt1(getpoint"起点"))(setq pt2(getpoint"PT2"))(setq b(getreal"上下线段比"))(setq a0(getreal"线段夹角"))(setq n(getint"层数"))(defun FXF(ptx1ptx2bx ax0nx/r a1a2);;;函数开始(command"line"ptx1ptx2"");;;(setq r(distance ptx1ptx2));;;上条线的长度;;;(setq a(angle ptx1ptx2));;;上条线的角度(setq r(/(distance ptx1ptx2)bx));;;下条线的长度(setq a1(+(angle ptx1ptx2)(/(*pi ax0)180)));;;下条线的角度(setq a2(-(angle ptx1ptx2)(/(*pi ax0)180)));;;下条线的角度(if(=nx0)(list(command"line"ptx2(polar ptx2a1r)"")(command"line"ptx2(polar ptx2a2r)""))(list(FXF ptx2(polar ptx2a1r)bx ax0(1-nx));;;先调用的函数要改变局部变量的值，后调用的函数不可用局部变量(FXF ptx2(polar ptx2(-(angle ptx1ptx2)(/(*pi ax0)180))(/ (distance ptx1ptx2)bx))bx ax0(1-nx)))));;;函数结束(setvar"OSMODE"0)(FXF pt1pt2b a0n);;;函数调用(setvar"OSMODE"37)(command))程序3：(defun C:FX2();;;分形螺旋线--多线段(setq pt1(getpoint"起点"))(setq pt2(getpoint"PT2"))(setq n(getint"循环次数")) (setvar"OSMODE"0);;;关闭对象捕捉(command"pline")(setq r(distance pt1pt2));;;线的长度(setq a(angle pt1pt2));;;线的角度(command pt1pt2)(repeat n;;;循环开始(setq r(/r1.05));;;下条线的长度(setq a(+a(/pi10)));;;下条线的角度(setq pt2(polar pt2a r))(command pt2));;;循环结束(setvar"OSMODE"37);;;打开对象捕捉(command))。
CADLISP程序
1.计算所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)(d e f u n c:L L() (s e t v a r"c m d e c h o"1) (setq en (ssge t(list '(0 . "spline,a rc,line,ellipse,LW POLYLIN E")))) (s e t q i0) (s e t q l l0) (r e p e a t(s s l e n g t h e n) (s e t q s s(s s n a m e e n i)) (s e t q e n d a t a(e n t g e t s s))(c o m m a n d"l e n g t h e n"s s"")(s e t q d d(g e t v a r"p e r i m e t e r")) (s e t q l l(+d d l l)) (s e t q i(1+i)))(p r i n c"所选线条总长为：")(p r i n c l l)(p r i n c))2.标注所有线段(加载后只需框选所有线段便可得标注这些线段)(d e f u n c:L L L() (C O M M A N D"U C S""") (s e t v a r"c m d e c h o"1) (S E T V A R"O S M O D E"0) (s e t q A c a d O b j e c t(v l a x-g e t-a c a d-o b j e c t)A c a d D o c u m e n t(v l a-g e t-A c t i v e D o c u m e n t A c a d o b j e c t)m S p a c e(v l a-g e t-M o d e l S p a c e A c a d d o c u m e n t));;选取需要测量的样条曲线、圆弧、直线、椭圆(setq en (ssge t(list '(0 . "spline,a rc,line,ellipse,LW POLYLIN E")))) (s e t q i0) ;;获取系统参数t e x t s i z e (s e t q s h h(g e t v a r"t e x t s i z e")) (s e t q s t r_h h(s t r c a t"\n文字高度<"(r t o s s h h2)">:"))(s e t q h h(g e t d i s t s t r_h h)) (w h i l e h h (s e t v a r"t e x t s i z e"h h) (s e t q h h n i l)) ;;输入标注文字高度;;循环开始(r e p e a t(s s l e n g t h e n) (s e t q s s(s s n a m e e n i)) (s e t q e n d a t a(e n t g e t s s))(c o m m a n d"l e n g t h e n"s s"")(s e t q d d(g e t v a r"p e r i m e t e r")) (p r i n c(s t r c a t"\n长度="(r t o s d d2))) ;;寻找代表图层的字符串(s e t q a a(a s s o c0e n d a t a)) ;;获取图层名称(s e t q a a1(c d r a a));;判断线条种类(c o n d((=a a1"S P L I N E") ;;如果是s p l i n e(p r o g n (s e t q a r c O b j(V L A X-E N A M E->V L A-O B J E C T s s)) (s e t q s t a r t P n t1(v l a-g e t-C o n t r o l P o i n t s a r c O b j))(s e t q p 1 (v l a x-s a f e a r r a y->l i s t(v l a x-v a r i a n t-v a l u e s t a r t P n t1))) (s e t q x1(c a r p1))(s e t q y1(c a d r p1)) (s e t q z1(c a d d r p1)) (s e t q p p1(l i s t x1y1z1)) (r e p e a t(-(/(l e n g t h p1)3)1) ;;循环，寻找最后一个控制点(s e t q x2(c a r p1))(s e t q y2(c a d r p1))(s e t q z2(c a d d r p1))) (s e t q p p2(l i s t x2y2z2)))) ((=a a1"L W P O L Y L I N E") ;;如果是L W P O L Y L I N E(p r o g n (s e t q a r c O b j(V L A X-E N A M E->V L A-O B J E C T s s)) (s e t q s t a r t P n t1(v l a-g e t-C o o r d i n a t e s a r c O b j)) (s e t q p 1 (v l a x-s a f e a r r a y->l i s t(v l a x-v a r i a n t-v a l u e s t a r t P n t1)))(s e t q y1(c a d r p1)) (s e t q z1(c a d d r p1)) (s e t q p p1(l i s t x1y1z1)) (r e p e a t(-(/(l e n g t h p1)3)1) ;;循环，寻找最后一个控制点(s e t q p1(c d d d r p1))(s e t q x2(c a r p1))(s e t q y2(c a d r p1))(s e t q z2(c a d d r p1))) (s e t q p p2(l i s t x2y2z2))))(t ;;如果是其他种类线条(p r o g n (s e t q a r c O b j(V L A X-E N A M E->V L A-O B J E C T s s)) (s e t q s t a r t P n t1(v l a-g e t-S t a r t P o i n t a r c O b j));;获取起点(s e t q e n d P n t1(v l a-g e t-E n d P o i n t a r c O b j));;获取终点(s e t q p p 1 (v l a x-s a f e a r r a y->l i s t(v l a x-v a r i a n t-v a l u e s t a r t P n t1)))(s e t q p p2(v l a x-s a f e a r r a y->l i s t(v l a x-v a r i a n t-v a l u e e n d P n t1)))))) (s e t q x1(c a r p p1))(s e t q y1(c a d r p p1)) (s e t q z1(c a d d r p p1)) (s e t q x2(c a r p p2)) (s e t q y2(c a d r p p2)) (s e t q z2(c a d d r p p2)) (s e t q x(/(+x1x2)2)) (s e t q y(/(+y1y2)2)) (s e t q z(/(+z1z2)2)) (s e t q p t(l i s t x y z)) ;;取得线段两端的中点(s e t q a n g(a n g l e p p1p p2)) ;;获取角度(i f(>(*(/a n g p i)180)180)(s e t q a n g(+a n g p i)))(c o m m a n d"t e x t""j""b c"p t""(*(/a n g p i)180) (s t r c a t""(r t o s d d2))"") (s e t q i(1+i)))(p r i n1))(p r o m p t"\n<>在图中直接写出长度") (p r i n1)3.连续打断程序(d e f u n c:b r1()(c o m m a n d"b r e a k"p a u s e"f"p a u s e"@"))4.将C A D文字导入E x c e l表格(d e f u n c:Q2() (s e t q f f n(g e t f i l e d"写出文件""""x l s"1)) (p r i n c"\n选取文字...") (s e t q s s(s s g e t)) (s e t q f f(o p e n f f n"w")) (s e t q i0) (r e p e a t(s s l e n g t h s s) (s e t q s s n(s s n a m e s s i)) (s e t q s s d a t a(e n t g e t s s n)) (s e t q s s t y p(c d r(a s s o c0s s d a t a))) (i f(o r(=s s t y p"T E X T")(=s s t y p"M T E X T"))(p r o g n (s e t q t x t(c d r(a s s o c1s s d a t a))) (p r i n c t x t f f) (p r i n c"\n"f f)))(s e t q i(1+i)))(c l o s e f f) (p r i n c(s t r c a t"\n写出文件:"f f n)) (p r i n1) )5删除带颜色图元以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次.改颜色的LISP程序(defun c:c1()(ssget)(command "chprop" "p" "" "c" "1" "") (princ))(defun c:c2()(ssget)(command "chprop" "p" "" "c" "2" "") (princ)) (defun c:c3()(ssget)(command "chprop" "p" "" "c" "3" "") (princ)) (defun c:c4()(ssget)(command "chprop" "p" "" "c" "4" "") (princ)) (defun c:c5()(ssget)(command "chprop" "p" "" "c" "5" "") (princ)) (defun c:c6()(ssget)(command "chprop" "p" "" "c" "6" "") (princ)) (defun c:c7()(ssget)(command "chprop" "p" "" "c" "7" "") (princ)) (defun c:c8()(ssget)(command "chprop" "p" "" "c" "8" "") (princ))你用C1 命令就可以将图元改为红色了.其余类似.删除红色图元(defun C:D1 (/ m A M)(setq m:err *error* *error* *merr*)(setvar "cmdecho" 0)(command "UNDO" "G")(prompt "选择图形")(setq A (ssget '((62 . 1)) ))(if (/= A nil)(progn(setq M (sslength A))(command "erase" A "")(princ "\n共删除红色图元<")(princ M)(princ ">个")))(command "UNDO" "E")(princ) )这样,键入D1 命令,就可以删除红色的图元了.。
柱体(管子)相贯线展开lisp程序
; kcmax (/ dx (sin j));大管开孔最大长
Rd (/ dm 2);大管半径
Rdzc (/ (* Rd pi) 2);大管展开长的1/4，作为开孔中心
Rx (/ dx 2);小管半径
x0 100
y0 100
qdmt (list x0 y0);画小管马蹄图起点
(command )
(setq qdk pdik)
(command );少一次此命令就是单步循环，必须用鼠标在绘图区单击，单击一次走一循环步
)
)
)
;***
(defun xz ()
(command "text" "100,80" "10" "0"
"先以较大步距画一条线，查看最小曲率区，再以1/2步距画另一条，根据需要确定是取数还是用线，详细说明见 BJZKL.TXT 一文。"
qd0 qd
n 0
ji 0
)
(while (< n zkbs)
(setq zd (list xi yi))
(setq n (+ n 1)
ji (+ ji j1)
aRx0 (- Rx (* Rx (cos ji)))
aRxl (* Rx (sin ji))
Rdli (sqrt (- (* Rd Rd) (* aRxl aRxl)))
这是在r14那个年代写的一个程序用以解决手工划线之苦今天已有各种管子切割机可用但当在简陋条件下还会用的上故拿出供需用者一试
这是在R14那个年代写的一个程序，用以解决手工划线之苦，今天已有各种管子切割机可用，但当在简陋条件下还会用的上，故拿出供需用者一试。注解详尽，可供初学者参考。
五个实用的AutoCAD的lisp程序
五个实用的AutoCAD的lisp程序1、计算CAD图形中所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)(defun c:LL ()(setvar "cmdecho" 1)(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))(setq i 0)(setq ll 0)(repeat (sslength en)(setq ss (ssname en i))(setq endata (entget ss))(command "lengthen" ss "")(setq dd (getvar "perimeter"))(setq ll (+ dd ll))(setq i (1+ i)))(princ "所选线条总长为：")(princ ll)(princ))2、标注CAD图形中所有线段(加载后只需框选所有线段便可得标注这些线段)(defun c:LLL ()(COMMAND "UCS" "")(setvar "cmdecho" 1)(SETVAR "OSMODE" 0)(setq AcadObject (vlax-get-acad-object)AcadDocument (vla-get-ActiveDocument Acadobject)mSpace (vla-get-ModelSpace Acaddocument));;选取需要测量的样条曲线、圆弧、直线、椭圆(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))(setq i 0);;获取系统参数textsize(setq shh (getvar "textsize"))(setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: "))(setq hh (getdist str_hh))(while hh(setvar "textsize" hh)(setq hh nil));;输入标注文字高度;;循环开始(repeat (sslength en)(setq ss (ssname en i))(setq endata (entget ss))(command "lengthen" ss "")(setq dd (getvar "perimeter"))(princ (strcat "\n长度=" (rtos dd 2)));;寻找代表图层的字符串(setq aa (assoc 0 endata));;获取图层名称(setq aa1 (cdr aa));;判断线条种类(cond((= aa1 "SPLINE");;如果是spline(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))(setq startPnt1 (vla-get-ControlPoints arcObj))(setq p1(vlax-safearray->list (vlax-variant-value startPnt1)) )(setq x1 (car p1))(setq y1 (cadr p1))(setq z1 (caddr p1))(setq pp1 (list x1 y1 z1))(repeat (- (/ (length p1) 3) 1);;循环，寻找最后一个控制点(setq p1 (cdddr p1))(setq x2 (car p1))(setq y2 (cadr p1))(setq z2 (caddr p1)))(setq pp2 (list x2 y2 z2))))((= aa1 "LWPOLYLINE");;如果是LWPOLYLINE(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss)) (setq startPnt1 (vla-get-Coordinates arcObj)) (setq p1(vlax-safearray->list (vlax-variant-value startPnt1)) )(setq x1 (car p1))(setq y1 (cadr p1))(setq z1 (caddr p1))(setq pp1 (list x1 y1 z1))(repeat (- (/ (length p1) 3) 1);;循环，寻找最后一个控制点(setq p1 (cdddr p1))(setq x2 (car p1))(setq y2 (cadr p1))(setq z2 (caddr p1)))(setq pp2 (list x2 y2 z2))))(t;;如果是其他种类线条(progn(setq arcObj (VLAX-ENAME->VLA-OBJECT ss)) (setq startPnt1 (vla-get-StartPoint arcObj));;获取起点(setq endPnt1 (vla-get-EndPoint arcObj));;获取终点(setq pp1(vlax-safearray->list (vlax-variant-value startPnt1)))(setqpp2 (vlax-safearray->list (vlax-variant-value endPnt1)) ))))(setq x1 (car pp1))(setq y1 (cadr pp1))(setq z1 (caddr pp1))(setq x2 (car pp2))(setq y2 (cadr pp2))(setq z2 (caddr pp2))(setq x (/ (+ x1 x2) 2))(setq y (/ (+ y1 y2) 2))(setq z (/ (+ z1 z2) 2))(setq pt (list x y z));;取得线段两端的中点(setq ang (angle pp1 pp2));;获取角度(if (> (* (/ ang pi) 180) 180)(setq ang (+ ang pi)))(command "text""j""bc"pt""(* (/ ang pi) 180)(strcat "" (rtos dd 2))"")(setq i (1+ i)))(prin1))(prompt "\n <>在图中直接写出长度") (prin1)3、连续打断程序(defun c:br1 ()(command "break" pause "f" pause "@"))4、将CAD文字导入Excel表格(defun c:Q2()(setq ffn (getfiled "写出文件" "" "xls" 1))(princ "\n选取文字...")(setq ss (ssget))(setq ff (open ffn "w"))(setq i 0)(repeat (sslength ss)(setq ssn (ssname ss i))(setq ssdata (entget ssn))(setq sstyp (cdr (assoc 0 ssdata)))(if (or (= sstyp "TEXT") (= sstyp "MTEXT"))(progn(setq txt (cdr (assoc 1 ssdata)))(princ txt ff)(princ "\n" ff)))(setq i (1+ i)))(close ff)(princ (strcat "\n写出文件: " ffn))(prin1))5、删除带颜色图元以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次。
几个有用的CAD的加载程序LISP
几个有用的CAD的加载程序LISP几个有用的CAD的加载程序LISP (2013-01-10 18:58:27)转载▼标签： cad加载程序杂谈分类： CAD应用1.图层命令;;; -----------------------------------------------------------------;;; 2 图层命令;;; ------------------------------------------------------------------;;; 2.1 LayerOff 关闭物体所在的层（单选）(defun c:1 (/ ent lname)(setvar "cmdecho" 0)(setq ent (entsel "\nPick an entity on the target layer: "))(if ent(progn(setq ent (entget (car ent)))(setq lname (cdr (assoc 8 ent))))(setq lname (getstring "\nNot to selected, Input layer name: ")))(if (= (getvar "clayer") lname)(setvar "clayer" "0"))(command "layer" "off" lname "")(princ));;; 2.2 LayerOffM 关闭物体所在的层（多选）(Defun C:LayerOffM ()(setvar "cmdecho" 0)(prompt "\nSelect entities to turn off:") (setq ss (ssget))(if (andss(sslength ss))(progn(setq ct 0len (sslength ss)cl (getvar "clayer"))(command ".layer")(while (< ct len)(setq la (cdr (assoc 8 (entget (ssname ss ct))))) (if (/= cl la)(command "off" la)(progn(prompt "\nThe layer")(prompt la)(prompt "is CURRENT!")))(if (= old nil)(setq OLD la)(setq OLD (strcat OLD "," la)))(setq ct (1+ ct)))(command "")))(princ)(setvar "cmdecho" 0)(prin1));;; 2.3 LayerOffOther 关闭物体以外的层(defun c:LayerOffOther (/ ent lname)(setvar "cmdecho" 0)(setq ent (entsel "\nPick an entity on the target layer: ")) (if ent(progn(setq ent (entget (car ent)))(setq lname (cdr (assoc 8 ent)))(setvar "clayer" lname)))(command "layer" "off" "*" "n" "")(princ));;; 2.3.1 LayerOffOtherM 关闭物体以外的层（多选）(Defun C:2 (/ ss ct cl la old)(setvar "cmdecho" 0)(prompt "\nSelect entities on the layers you want to remain:") (setq ss (ssget))(setq ct 0len (sslength ss)cl (cdr (assoc 8 (entget (ssname ss 0)))))(setvar "clayer" cl)(while (< ct len)(setq la (cdr (assoc 8 (entget (ssname ss ct)))))(if (= old nil)(setq OLD la)(setq OLD (strcat OLD "," la)))(setq ct (1+ ct)))(command ".layer" "off" "*" "n" "")(command ".layer" "on" old "")(princ));;; ------------------------------------------------------------------;;; 2.4 LayerLockM 锁住物体所在的层（多选）(defun C:4 (/ ES EN EL A)(princ "Selected Entity(s) Layers Locked.")(setq ES (ssget)A 0EN ""EL nilFL nil)(while (/= EN nil)(setq EN (ssname ES A)EL (cons EN EL)A (1+ A)))(setq EL (cdr EL)FL (cdr (assoc '8 (entget (car EL))))EL (cdr EL))(repeat (- A 2)(setq EN (cdr (assoc '8 (entget (car EL))))FL (strcat EN "," FL)EL (cdr EL)))(command "LAYER" "LO" (eval FL) "") (princ));;; 2.5 LayerUnlockM 解锁物体所在的层（多选）(defun C:5 (/ ES EN EL A)(princ "Selected Entity(s) Layers Unlocked.") (setq ES (ssget)A 0EN ""EL nilFL nil)(while (/= EN nil)(setq EN (ssname ES A)EL (cons EN EL)A (1+ A)))(setq EL (cdr EL)FL (cdr (assoc '8 (entget (car EL)))))(repeat (- A 2)(setq EN (cdr (assoc '8 (entget (car EL))))FL (strcat EN "," FL)EL (cdr EL)))(command "LAYER" "U" (eval FL) "")(princ));;; ------------------------------------------------------------------;;; 2.6 LayerFreezeM 冻结物体所在的层（多选）(defun C:LayerFreezeM (/ ES EN EL A)(princ "Selected Entity(s) Layers Freezed.")(setq ES (ssget)A 0EN ""EL nilFL nil)(while (/= EN nil)(setq EN (ssname ES A)EL (cons EN EL)A (1+ A)))(setq EL (cdr EL)FL (cdr (assoc '8 (entget (car EL)))))(repeat (- A 2)(setq EN (cdr (assoc '8 (entget (car EL))))FL (strcat EN "," FL)EL (cdr EL)))(command "LAYER" "F" (eval FL) "")(princ));;; 2.7 LayerThawAll 解冻所有的层(Defun C:LayerThawAll ()(COMMAND "LAYER" "THAW" "*" "")(PRINC));;; ------------------------------------------------------------------;;; 2.8 LayerCurrent 将物体所在的层设为当前层(defun c:LayerCurrent (/ ent lname)(setvar "cmdecho" 0)(setq ent (car (entsel "\nPick an entity on the target layer: "))) (if ent(progn(setq ent (entget ent)lname (cdr (assoc 8 ent))))(progn(setq lname (getstring "\nNot to selected, Input layer name:))(setvar "clayer" lname)(princ));;; ------------------------------------------------------------------;;; 2.9 LayerOnAll 打开所有层(Defun C:3 ()(command "layer" "on" "*" "")(princ));;; ------------------------------------------------------------------;;; 2.10 ToCurrentLayerM 将物体转到当前层（多选），并使用层颜色，线型(defun c:T oCurrentLayerM (/ lname ss)(setq ss (ssget))(if ss(progn(setq lname (getvar "clayer"))(command "chprop" ss "" "la" lname "color" "bylayer" "ltype" "bylayer"""))));;; ----------------------------------------------------------------;;; 2.11 ToLayerMatch 通过目标物体改变选择实体的图层属性(defun c:T oLayerMatch (/ lname ss ent)(setvar "cmdecho" 0)(prompt "\nSelect the entity(s): ")(setq ss (ssget))(if ss(progn(setq ent (entsel "\nPick an entity on the target layer: "))(if ent(progn(setq ent (entget (car ent)))(setq lname (cdr (assoc 8 ent))))(progn(setq lname (getstring "\nNot to selected, Input layer name: "))))(command "chprop" ss "" "la" lname "")))(princ))快捷键1-掩藏图层快捷键2-只显示选中图层快捷键3-显示全部图层0000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000002.增强复制;;;********************************************************图形矫正程序-jz(defun c:cc (/ p1 p2 s e cn);__________________(defun ttt (ss n / m)(setq ee ens (ssadd))(while (setq ee (entnext ee))(setq ns (ssadd ee ns)))(command "erase" ns "")(command "copy" ss "" "m" "non" p1)(setq m 0)(repeat (atoi n)(setq m (1+ m))(cond((= "/" (substr n (strlen n)))(command"non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n)))))p1p2)))(t(command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2)))))(command));__________________(princ "\n选择要复制的物体:")(setq s (ssget))(setq p1 (getpoint "\n复制的起点:"))(setq p2 (getpoint p1 "\n复制的终点:"))(setq e (entlast))(command "copy" s "" "non" p1 "non" p2) (while (/= 0(atof (setq cn (getstring "\n份数(以 / 结束为等分):"))) )(ttt s cn))(princ))(defun c:c1 (/ p1 p2 s e cn a1 d1 ns cnn);__________________(defun ttt (ss n / m)(setq ee ens (ssadd))(while (setq ee (entnext ee))(setq ns (ssadd ee ns)))(command "erase" ns "")(command "copy" ss "" "m" "non" p1)(if (member (substr n (strlen n)) '("/" "*")) (progn(setq m 0)(repeat (atoi n)(setq m (1+ m))(cond((= "/" (substr n (strlen n)))(command"non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1p2)))((= "*" (substr n (strlen n)))(command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2))))))(command "non" (setq p2 (polar p1 a1 (atof n)))) )(command));__________________(princ "\n选择要复制的物体:")(setq s (ssget))(setq p1 (getpoint "\n复制的起点:"))(command "undo" "be" "line" p1 p1 "")(setq e (entlast))(command "copy" s "" "non" p1 pause)(setq p2 (getvar "lastpoint")a1 (angle p1 p2)d1 (distance p1 p2))(setq cn "1*")(while cn(ttt s cn)(initget 128)(princ"\n输入坐标=复制终点输入数值=修改间距 ")(princ"\n输入数值n并以 / 结束=间距内等分n次复制输入数值n并以 * 结束=按间距复制n次 ")(setq cnn (getpoint "\n请按提示输入<退出>:"))(if (= 'LIST (type cnn))(setq p2 cnna1 (angle p1 p2)d1 (distance p1 p2))(setq cn cnn)))(entdel e)(command "undo" "e")(princ))(defun c:c2 (/ p1 p2 s e cn);__________________(defun ttt (ss n / m)(setq ee ens (ssadd))(while (setq ee (entnext ee))(setq ns (ssadd ee ns)))(command "erase" ns "")(command "copy" ss "" "m" "non" p1)(setq m 0)(repeat (atoi n)(setq m (1+ m))(cond((= "/" (substr n (strlen n)))(command"non"(mapcar '(lambda (x y) (+ x (* m (/ (- y x) (atof n))))) p1p2)))(t(command "non"(mapcar '(lambda (x y) (+ x (* m (- y x)))) p1 p2))))(command));__________________(princ "\n选择要复制的物体:")(setq s (ssget))(setq p1 (getpoint "\n复制的起点:"))(setvar "lastpoint" p1);(setq p2 (getpoint p1 "\n复制的终点:"))(setq e (entlast))(command "copy" s "" "non" p1 pause)(if (not (equal p1 (setq p2 (getvar "lastpoint")))) (while (/= 0(atof (setq cn (getstring "\n份数(以 / 结束为等分):"))) )(ttt s cn)))(princ));;;|增强拷贝(defun c:c3 (/ getpt getpt1 ss ptx pty db n x y gtin) (setq getpt1 (acet-ss-drag-move(setq ss (ssget))(setq getpt (getpoint "\n&点取基点:"))1)(setq ptx (- (car getpt1) (car getpt))pty (- (cadr getpt1) (cadr getpt))y 0)(vl-cmdf ".copy" ss "" getpt getpt1) (while (setq gtin (- (getint "\n重复次数:") 1)) (vl-cmdf ".undo" "e")(if (/= y 0)(vl-cmdf ".u"))(setq n 1x 0db nil)(if (/= y 0)(vl-cmdf ".u"))(vl-cmdf ".undo" "be")(repeat gtin(setq db (cons (list (+ (* n ptx) (car getpt1)) (+ (* n pty) (cadr getpt1))0.0)db))(setq n (1+ n)))(repeat (length db)(vl-cmdf ".copy" ss "" getpt (nth x (reverse db)))(setq x (1+ x)))(vl-cmdf ".undo" "e")(vl-cmdf ".undo" "be")(setq y (1+ y)))(princ))快捷键C1-等分复制快捷键C2-多重复制0000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000003.墙柱工具无敌（雨夜屠夫）VLX文件，自己上网搜索。
lisp经典语句数值
lisp经典语句数值设置默认数值(if (= (setq th (getreal "输入墙厚度：（默认为0.25）：")) nil) (setq th 0.25))设置当前环境(setvar "cmdecho" 0) ;不显示提示文字(setvar "plinewid" 0.2 ) ;设置绘图线宽为0.2(setvar "osmode" 0) ;设置当前捕捉为关闭状态(command "undo" "be" "")恢复上一个命令(command "text" "c" pt3 hgt ang1 txt1) 添加文字信息在意图面(command "text" "c" pt3 hgt ang1 txt1)(DEFUN C:szzt()(command "style" "细等线体" "方正细等线简体" "0" "1" "0" "n" "n" ) ;标注文字样式(command "style" "中等线体" "方正中等线简体" "0" "1" "0" "n" "n" ) ;文字样式(command "style" "宋体" "方正书宋_GBK" "0" "1" "0" "n" "n" ) ;标注文字样式(command "style" "黑体" "黑体" "0" "1" "0" "n" "n" ) ;标注文字样式(command "style" "HZ" "txt,hztxt" "0" "0.8" "0" "n" "n" "n")(princ "\n文字样式已设定!"))(DEFUN C:tdc()(COMMAND "LAYER" "M" "HX" "C" "1" "" "")(COMMAND "LAYER" "M" "LH" "C" "3" "" "")(COMMAND "LAYER" "M" "ZX" "C" "2" "" "")(COMMAND "LAYER" "M" "绿化占地" "C" "3" "" "")(COMMAND "LAYER" "M" "道路占地" "C" "1" "" "")(COMMAND "LAYER" "M" "建设用地" "C" "7" "" "")(COMMAND "LAYER" "M" "解算" "C" "4" "" "")(COMMAND "LAYER" "M" "用地范围线" "C" "7" "" "")(COMMAND "LAYER" "M" "边界线" "C" "4" "" "")(COMMAND "LAYER" "M" "勘界线" "C" "6" "" "")(COMMAND "LAYER" "M" "利用" "C" "16" "" "")(COMMAND "LAYER" "M" "外业" "C" "5" "" "")(COMMAND "LAYER" "M" "图框" "C" "7" "" "")(COMMAND "LAYER" "M" "现状地形" "C" "5" "" "")(COMMAND "CLAYER" "解算"))(defun c:hzhj)(setq pt11(getpoint "\n请指定点："))(command "text" "m" pt11 10 0 "合计")(command ""))(command "_text" "j" "mc" (getpoint "\n点取总面积标注点:")3 0 (rtos sumArea 2 3))(command "style" "细等线体" "方正细等线简体" "0" "1" "0" "n" "n" )(defun maketext (txt pt)(entmake (list '(0 . "TEXT") (cons 10 pt) (cons 40 hzg) (cons 1 txt) (cons 11 pt) (cons 72 1) (cons 73 2) '(41 . 0.8))))(defun c:hzhj)(setq pt9(getpoint "\n请指定点："))(command "text" "m" pt9 10 0 "小计")(command ""))(setq s1 (getint "输入距离A:(100)"))(setq s2 (getint "输入距离B:(40)"))(if (= s1 nil) (setq s1 100))(if (= s2 nil) (setq s2 40) )(setq p1 (getpoint"\n点取角点坐标"))(setq p1 (p-zs p1))(setq xx (car p1))(setq yy (cadr p1))(setq p2 (list (+ xx 10) yy))(setq p3 (list (+ xx 10) (+ 10 yy)))(setq p4 (list xx (+ yy 10)))(command "pline" p1 p2 p3 p4 "c" "")(defun c:hd()(setvar "osmode" 33)(setq pX1 (getpoint "\n点选点A<回车退出>:"))(setq pX2 (getpoint "\n方向点B:"))(setq wzjd (angtos (angle pX1 pX2) 1 4))(setq aNGX (angle pX1 pX2))(SETQ AA (rtos angX 2 6))(command "_text" "j" "mc" (getpoint "\n请选取标注点:") 3 wzjd AA) )(defun c:tybj (/ sel int rad dat)(if (and (setq sel (ssget '((0 . "CIRCLE"))))(setq int 0rad (getdist "\n半径:")))(repeat (sslength sel)(setq dat (entget (ssname sel int))int (1+ int))(entmod (subst (cons 40 rad) (assoc 40 dat) dat))))(princ))(defun c:wzg0(/ ent ents ang)(princ "选择要修改的文字，可多选")(setq ss (ssget '((0 . "*TEXT"))))(setq ang (getangle "\n输入角度:<0>"))(if (= ang nil)(setq ang 0))(setq k 0)(repeat (sslength ss)(progn(setq ent (ssname ss k))(setq ents (entget ent))(setq ents (subst (cons 50 ang) (assoc 50 ents) ents)) (entmod ents)(entupd ent)(setq k (1+ k))))(princ))。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
；;一、绘制地形图符号1。
点状符号对于点状符号,其位置固定,数量较多，且一般都带有一定的标注,可逐个制作属性块图元，单独插入.2。
线状符号利用AutoCAD中强大的线型定义。
3。
面状符号由充填符号在面域内按一定的排列方式组合而成。
目前Auto CAD在建筑设计、工程施工放样得到广泛应用，Auto CAD在工程测量上的应用，大大减少手算坐标的工程量或帮助人们复核手算坐标的准确性。
（1）删除未选择对象(defun c:sd()（princ”\n选择要保留对象：")（setq SS（ssget）ss1(ssget"X"）)(command”erase"ss1”r”ss”"zoom _e））；end;;(2)画圆弧型铁路;输入铁路中线上三个点,轨距及绘图比例尺，起、中、始点(defun c:ytl()(setvar "osmode”0)；取消扑捉（setq PB(getpoint"\n输入起点：”)）（setq PM(getpoint"\n输入中点："）)（setq PE(getpoint"\n输入终点："))(setq WD(getreal"\n输入铁路宽度(m）：”））(setq S(getreal”\n绘图比例尺=："））;1:1000，输入1。
0(setq W1（/（* WD S）2）W2(+ W1(* 0.6 S）))；轨道及枕木符号的半宽(setq D（distance PB PE）)（setq A1（angle PB PM）A2（angle PB PE）A3（angle PE PB）A4(angle PE PM)）(setq FB（— A1 A2）FE（— A3 A4) P12(＊PI 2)）（if (< FB 0）(setq FB（+ FB P12)））;求PB和PE点的圆周角(if (< FE 0）(setq FE(+ FE P12))）(setq F（+ FB FE) R（/ D(* （sin F)2））);求全弧所对圆心角之半，圆弧半径(setq F1(- (/ PI 2）F) ABC(- A2 F1))(if （< ABC 0) (setq ABC(+ ABC P12)）)(setq C(polar PB ABC R）)；求圆心之点位(setq ACB（angle C PB）ABC(angle PB C））;起点左右垂直于中线切线的方位角(setq ACM(angle C PM）AMC(angle PM C）)；中点左右垂直于中线切线的方位角(setq ACE(angle C PE) AEC（angle PE C)）;终点左右垂直于中线切线的方位角(setq PBL（polar PB ACB W1) PBL1(polar PB ACB W2)）（setq PBR(polar PB ABC W1）PBR1（polar PB ABC W2）)(setq PML（polar PM ACM W1) PMR（polar PM AMC W1)）(setq PEL(polar PE ACE W1) PER（polar PE AEC W1))（setq S2（＊0.2 S) S4（* 0。
4 S) S10(＊10 S))(command ”pline" PBL "w" S2 S2 ”A”"S”PML PEL ”");画左右铁路连线（command "pli ne" PBR "w” S2 S2 "A" ”S” PMR PER "")(command ”pline" PBL1 ”w" S4 S4 PBR1 ””);画起点处枕木(setq DF（/（＊10 S）R))；求一个分段圆弧所对圆心角(setq FF 0）；动态分段圆弧之和，所对圆心角初值赋0(while(< FF（＊F 2))(command ”pline" PL "W”S4 S4 PR "")；画分段处枕木(setq FF(+ FF DF）)（setq ACP(— ACB FF）P（polar c ACP R))(setq APC（angle P C)PL（polar P ACP W2) PR(polar P APC W2）))(PRINC））；END；;（3）弧度化度分秒函数;;如0.356弧度化为”20。
2350”,即20°23’50"（defun dfm（hdj）(setq jd（/（* hdj 180）pi))（setq du(fix jd)）；截去小数，提取度数（setq f1（＊60 （- jd du))）(setq ff（fix f1)）；截去小数,提取分数(setq mm(rtos（* 60 (—f1 ff）) 2 0)）；按四舍五入提取秒数；；上面的du，ff是整型数，mm是字符串（setq du（itoa du）ff（itoa ff));把du，ff转化为字符串(if （<（strlen ff）2);求ff长度(setq ff(strcat "0”ff）)；如果ff长度小于2，执行此表达式（setq ff ff）;如果ff长度等于2，执行此表达式）（if （〈（strlen mm）2）;求mm长度(setq mm（strcat ”0" mm))；如果mm长度小于2，执行此表达式（setq mm mm）；如果mm长度等于2,执行此表达式)(setq jd（strcat du "." ff mm）)；把度,小数点，分,秒放在一个字符串中）；end；;（4)度分秒化成弧度（defun hhd（a）;按(hhd 6。
3628)调用（setq a(rtos a 2 4）) ;a转换为字符型（setq ws(strlen a)）；求角度a的长度，即判断度数的位数(setq ad (substr a 1 (—ws 5))) ；根据度数的位数取数给ad(setq am （substr a (- ws 3) 2）) ;根据度数的位数取数给am（setq as (substr a (- ws 1）2)）;根据度数的位数取数给as（setq a1 (atof ad)) ；把ad转换为实数(setq a2 (atof am)) ;把am转换为实数(setq a3 （atof as)) ；把as转换为实数(setq ar （+ a1 (/ a2 60) (/ a3 3600）))(setq ard (/ （* ar pi) 180）)（setq a ard））；end；；（5)标注面积（平方米和亩）(defun c：mj（)（setq os (getvar ”osmode"））;osmode是捕捉系统变量(setq cmd (getvar "cmdecho")）；CMDECHO是系统变量（setvar ”osmode” 0）（setvar ”cmdecho" 0）（setq p1 （getpoint "\n请在要标注封闭区域内点一下:"))（command ”-boundary”p1 ”");构建多段线边界(setq bj (entlast)）;获得边界（bj）图元名称（command "area" ”o" bj）；获得边界（bj）图元名称面积（entdel bj);删除边界(bj）图元名称(setq mj (rtos (getvar ”area”) 2 3))(setq area1 （strcat mj ”｛\\fSimSun|b0｜i0|c134｜p2；平方米(}"）)（setq ans （＊(/ (atof area1）10000。
0) 15。
0))(setq ans （rtos ans 2 3)）(setq area2 (strcat area1 ans ”｛\\fSimSun｜b0｜i0|c134|p2；亩)｝”）)(entmake （list '(0 。
"MTEXT”)’（100 . ”AcDbEntity"）’(100 . "AcDbMText"）（cons 10 p1）（cons 40 5)（cons 41 0）(cons 71 0)(cons 50 0)’(72 。
5）（cons 1 area2)）)；创建一个新图元(setvar ”osmode" os)(setvar "cmdecho” cmd)（princ)）;end;；(6）对单行文字修改主程序(DEFUN C：GWZ（)（princ "\nselect object:"）（setq s (ssget))(GJD）；调用修改文字角度函数（GGD)；调用修改文字高度函数);结束（defun GJD();修改文字角度函数(setq hig (getreal ”\n输入角度〈0>:”)）（if (= hig nil）(setq hig 0。
0））(setq hig （* pi hig）hig (/ hig 180。
0)) (setq h50 （cons 50 hig）)（setq n (sslength s））（setq k 0 )（while （〈k n）(setq name （ssname s k)）(setq a (entget name)）(setq b （assoc '0 a））（setq b (cdr b))（if （= b ”TEXT”)(progn（setq h （assoc '50 a）)（setq a (subst h50 h a）)（entmod a））)(setq k （+ k 1))))；结束(DEFUN GGD (）;修改文字高度函数（setq hig (getreal ”\n输入新字高<3〉:”））(if （= hig nil) （setq hig 3。
0））（setq h40 (cons 40 hig))（setq n (sslength s)）（setq k 0 )(while (〈k n)（setq name （ssname s k）)(setq a (entget name）)(setq b （assoc '0 a）)（setq b (cdr b))（if (= b "TEXT”)（progn(setq h (assoc ’40 a））（setq a (subst h40 h a）)(entmod a）））(setq k (+ k 1)）)）。