cadlisp二次开发实例?

cadlisp二次开发实例?,第1张

AutoCAD的二次开发主要涉及以下内容:(1)编写各种用户自定义函数并形成若干LISP、ARX、VLX或ADS文件,以及一些DCL文件。(2)建立符合自己要求的菜单文件,一般可在AutoCAD原菜单文件内添加自己的内容,对于AutoCAD2000版本还可增加部分菜单文件,然后经交互方式加入到系统中去。(3)在系统的ACAD.LSP或类似文件中加入某些内容以便进行各种初始化 *** 作,如在启动时立即装入一些文件等。(4)通过系统对话框设置某些路径。这些 *** 作在程序开发成功后向其它AutoCAD系统上安装应用,特别是需要大批安装时,需要进行很多文件检索、内容增删、子目录创建、文件拷贝、系统设置等繁琐工作,如能令上述工作全部自动进行,使整个二次开发程序在无人干预的情况下嵌入系统,将大大提高工作效率。

AutoCAD荣登全球绘图软件的龙头宝座,主要是因为它具有开放的体系链派高结构。它允许用户和开发者采用高级编程语言对其进行扩充和修改,即二次开发,能最大限度地满足用户的特殊要求。AutoCAD第一版于1982年11月由AutoDESK公司推出,目前大家广泛使用的是AutoCAD2000或2002,最新版本是AutoCAD2004,其二次开发语言及工具也在不断地涌现

1AutoLISP

AutoLISP的全名是LISTProcessingLanguage,她出现于1985年推出的AutoCADR2.18中,是一种嵌入在AutoCAD内部的编程语言,是LISP原版的一个子集,她一直是低版本AutoCAD的首选编程语言。它是一种表处理语言,是被解释执行的,任何一个语句键入后就能马上执行,它对于交互式的程序开发非常方便。其缺点是继承了LISP语言的编程规则而导致繁多的括号。

3ADS

ADS的全名是AutoCADDevelopmentSystem,它是AutoCAD的C语言开发系统,ADS本质上是一组可以用C语言编写AutoCAD应用程序的头文件和目标库,它直接利用用户熟悉的各种流行的C语言编译器,将应用程序编译成可执行的文件在AutoCAD环境下运行,这种可以在AutoCAD环境中直接运行的可执行文件叫做ADS应用程序。ADS由于其速度快,又采用结构化的编程体系,因而很适合于高强度的数据处理,如二次开发的机械设计CAD、工程分析CAD、建筑结构CAD、土木工程CAD、化学工程CAD、电气工程CAD等。

4ObjectARX

ObjectARX是一种崭新的开发AutoCAD应用程序的工具,她以C++为编程语言,采用先进的面向对象的编程原理,提供可与AutoCAD直接交互的开发环境,能使用户方便快捷地开发出高效简洁的AutoCAD应用程序。ObjectARX并没有包含在AutoCAD中,可在AutoDESK公司网站中去下载,其最新版本是ObjectARXforAutoCAD2000,它能够对AutoCAD的所有事务进行完整的、先进的、面向对象的设计与开发,并且开发的应用程序速度更快、集成度更高、稳定性更强。ObjectARX从本质上讲,是一种特定的C++编程环境,她包括一组动态链接库(DLL),这些库与AutoCAD在同一地址空间运行并能直接利用AutoCAD核心数据结构和代码,库中包含一组通用工具,使得二次开发者可以充分利用AutoCAD的开放结构,直接访问AutoCAD数据库结构、图形系统以及CAD几何造型核心,以便能在运行期间实时扩展AutoCAD的功能,创建能全面享受AutoCAD固有命令的新命令。ObjectARX的核心是两组关键的API,即AcDb(AutoCAD数据库)和AcEd(AutoCAD编译器),另外还有其它的一些重要库棚尺组件,如AcRX(AutoCAD实时扩展)、AcGi(AutoCAD图形接口)、AcGe(AutoCAD几何库)、ADSRX(AutoCAD开发系统实时扩展)。ObjectARX还可以按需要加载应用程序;使用ObjectARX进行应用开发还可以在同一水平上与Windows系统集成,并与其它Windows应用程序实现交互 *** 作。

5VisualLISP

VisualLISP已经被完整地集成到AutoCAD2000中,羡悉她为开发者提供了崭新的、增强的集成开发环境,一改过去在AutoCAD中内嵌AtuoLISP运行引擎的机制,这样开发者可以直接使用AutoCAD中的对象和反应器,进行更底层的开发。其特点为自身是AutoCAD2000中默认的代码编辑工具;用它开发AutoLISP程序的时间被大大地缩短,原始代码能被保密,以防盗版和被更改;能帮助大家使用ActiveX对象及其事件;使用了流行的有色代码编辑器和完善的调试工具,使大家很容易创建和分析LISP程序的运行情况。在VisualLISP中新增了一些函数:如基于AutoLISP的ActiveX/COM自动化 *** 作接口;用于执行基于AutoCAD内部事件的LISP程序的对象反应器;新增了能够对 *** 作系统文件进行 *** 作的函数。

6VBA

VBA即Mcrosoftoffice中的VisualBasicforApplications,它被集成到AutoCAD2000中。VBA为开发者提供了一种新的选择,也为用户访问AutoCAD2000中丰富的技术框架打开一条新的通道。VBA和AutoCAD2000中强大的ActiveX自动化对象模型的结合,代表了一种新型的定制AutoCAD的模式构架。通过VBA,我们可以 *** 作AutoCAD,控制ActiveX和其它一些应用程序,使之相互之间发生互易活动。

初来乍到,向各位奉上本人自编的一些实用的AutoLisp程序,希望对大家有用。

其中命令包括:

c:/ ;格式刷

c:0 ;自定义坐标系

c:00 ;世界坐败滑标系

c:csh ;图层及标注样式初始化

c:cx ;x方向复制

c:cy ;y方向复制

c:j ;水平标注

c:k ;绘制圆引线序号

c:kk ;绘制方引线序号球

c:kkk ;绘制连续序号球

c:kkkk ;填充连续序号

c:lf 关闭选中对象图层

c:lg 关闭选中对象图层外的其他图层

c:ln 设置选中对象图层为当前图层

c:mx ;x方向移动

c:my ;y方向移动

以下是程序,欢迎大家指正:

图层管理程序==》

(defun c:csh () 初始化图层和标注样式

(setvar 'cmdecho 0)

(sztc1)

(szbz1)

(setvar 'cmdecho 1)

)

(defun c:ln () 设置选中对象图层为当前图层

(setq e1 (entget (car (entsel "\n选择一个对象:"))))

(entget (entlast))

(setq layer1 (assoc 8 e1))

(setq layername (cdr layer1))

(command "-layer" "s" layername "")

(prin1 layername)

)

(defun c:lf () 关闭选中对象图层

(setq e1 (entget (car (entsel "\n选择一个对象:"))))

(entget (entlast))

(setq layer1 (assoc 8 e1))

(setq layername (cdr layer1))

(command "-layer" "off" layername "")

(princ)

)

(defun c:lg () 关闭选中对象图层外的其他图层

(setq e1 (entget (car (entsel "\n选择一个对樱卜象,其余图层将被关闭:"))))

(setq layer1 (assoc 8 e1))

(setq layername (cdr layer1))

(command "-layer" "off" "察颂腊*" "y" "on" layername "s" layername "")

(princ)

)

《==图层管理程序

作图/标注程序==》

(defun c:a3 () 插入a3图框

(setq p1 (getpoint "\n放置点:"))

(command

"-insert"

"*C:\\Program Files\\AutoCAD 2007\\Support\\A3.dwg"

p1 ""

""

)

(princ)

)

(defun c:a4 () 插入a4图框

(setq p1 (getpoint "\n放置点:"))

(command

"-insert"

"*C:\\Program Files\\AutoCAD 2007\\Support\\A4.dwg"

p1 ""

""

)

(princ)

)

(defun c:00 () 自定义坐标

(command "ucs")

(princ)

)

(defun c:0 () 设置系统坐标

(command "ucs" "")

(princ)

)

(defun c:/ () 格式刷

(command "'_matchprop")

(princ)

)

(defun c:j () 直线标注

(command "-layer" "s" "6标注" "")

(command "_dimlinear")

(princ)

)

(defun c:jj () 圆或圆弧标注

(command "-layer" "s" "6标注" "")

(setq e1 (entget (car (entsel "选择圆或圆弧:"))))

(if (= (cdr (assoc 0 e1)) "ARC")

(command "_dimradius")

(command "_dimdiameter")

)

(princ)

)

序号球==》

(defun drawline (pt1 zh)

(if (= zh "h")

(progn (command "rectang"

(list (+ (car pt1) 8) (cadr pt1) (caddr pt1))

"@8,8"

)

(command "-array" "last" "" "r" "1" "10" "8")

)

(progn (command "rectang"

(list (car pt1) (- (cadr pt1) 8) (caddr pt1))

"@8,-8"

)

(command "-array" "last" "" "r" "10" "1" "-8")

)

)

)

(defun deleteline (pt1 zh)

(if (= zh "h")

(ssget "_w"

pt1

(list (+ (car pt1) 88) (+ (cadr pt1) 8) (caddr pt1))

'((0 . "LWPOLYLINE"))

)

(ssget "_w"

pt1

(list (+ (car pt1) 8) (- (cadr pt1) 88) (caddr pt1))

'((0 . "LWPOLYLINE"))

)

)

(command "erase" "p" "")

)

(defun c:k () 画引线序号球

(command "-layer" "s" "6标注" "")

(setq old_os (getvar 'osmode))

(setq zh (getstring "\n横向<h>?纵向<z>? <h>:"))

(if (= zh "")

(setq zh "h")

)

(setq p1 (getpoint "\n基点:"))

(setq p2 (getpoint "\n第二点:"))

(setq pt1 p2)

(drawline pt1 zh)

(while p1

(setq s (getstring "\n输入注释文字:"))

(setq dis (distance p1 p2))

(setq ang (angle p1 p2))

(setq p3 (polar p1 ang (- dis 3.5)))

(setvar 'osmode 0)

(command "line" p1 p3 "")

(command "circle" p2 "3.5")

(setq th (getvar 'dimtxt))

(command "text" "j" "mc" p2 th "" s "")

(setvar 'osmode old_os)

(setq p1 (getpoint "\n基点:"))

(if (= p1 nil)

(progn

(deleteline pt1 zh)

(princ

"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号"

)

(exit)

(princ)

)

)

(setq p2 (getpoint "\n第二点:"))

)

)

(defun c:kk () 画方引线序号球

(command "-layer" "s" "6标注" "")

(setq old_os (getvar 'osmode))

(setq zh (getstring "\n横向<h>?纵向<z>? <h>:"))

(if (= zh "")

(setq zh "h")

)

(setq p1 (getpoint "\n基点:"))

(setq p2 (getpoint "\n第二点:"))

(setq pt1 p2)

(drawline pt1 zh)

(while p1

(setvar 'osmode 0)

(setq s (getstring "\n输入注释文字:"))

(if (>(car p2) (car p1))

(if (>(cadr p2) (cadr p1))

(progn (setq p3 (list (- (car p2) 3.5) (- (cadr p2) 3.5) (caddr p2)))

(command "rectang" p3 "@7,7")

)

(progn (setq p3 (list (- (car p2) 3.5) (+ (cadr p2) 3.5) (caddr p2)))

(command "rectang" p3 "@7,-7")

)

)

(if (>(cadr p2) (cadr p1))

(progn (setq p3 (list (+ (car p2) 3.5) (- (cadr p2) 3.5) (caddr p2)))

(command "rectang" p3 "@-7,7")

)

(progn (setq p3 (list (+ (car p2) 3.5) (+ (cadr p2) 3.5) (caddr p2)))

(command "rectang" p3 "@-7,-7")

)

)

)

(command "line" p1 p3 "")

(setq th (getvar 'dimtxt))

(command "text" "j" "mc" p2 th "" s "")

(setvar 'osmode old_os)

(setq p1 (getpoint "\n基点:"))

(if (= p1 nil)

(progn

(deleteline pt1 zh)

(princ

"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号"

)

(exit)

(princ)

)

(setq p2 (getpoint "\n第二点:"))

)

)

)

(defun c:kkk () 画序号球

(command "-layer" "s" "6标注" "")

(setq old_os (getvar 'osmode))

(setq n (getint "\n设置起始值<1>"))

(if (= n nil)

(setq n 1)

)

(setvar 'osmode 32)

(setq p1 (getpoint "\n基点:"))

(while p1

(setq p2 (list (- (car p1) 5) (- (cadr p1) 5) (caddr p1)))

(setvar 'osmode 0)

(command "circle" p2 "3.5")

(command "text" "j" "mc" p2 "" "" n "")

(setq n (1+ n))

(setvar 'osmode 32)

(setq p1 (getpoint "\n下一基点:"))

)

(setvar 'osmode old_os)

(princ

"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号"

)

(princ)

)

(defun c:kkkk () 填写序号

(command "-layer" "s" "6标注" "")

(setq old_os (getvar 'osmode))

(setq n1 (getint "\n设置起始值<1>"))

(if (= n1 nil)

(setq n1 1)

)

(setq n2 (getint "\n设置结束值<10>"))

(if (= n2 nil)

(setq n2 10)

)

(setvar 'osmode 32)

(setq p1 (getpoint "\n基点:"))

(setq p2 (getpoint "\n下一点:"))

(setq p3 (list (/ (+ (car p1) (car p2)) 2)

(/ (+ (cadr p1) (cadr p2)) 2)

(caddr p1)

)

)

(setvar 'osmode 0)

(while (<n1 (1+ n2))

(command "text" "j" "mc" p3 "" "" n1 "")

(setq p3 (list (car p3)

(+ (cadr p3) (- (cadr p2) (cadr p1)))

(caddr p1)

)

)

(setq n1 (1+ n1))

)

(setvar 'osmode old_os)

(princ

"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号"

)

(princ)

)

《==作图/标注程序

移动复制程序==》

(defun c:mx ()

(setq ss (ssget))

(setq p1 (getpoint "\n基点:"))

(setq p2 (getpoint "\n第二点:"))

(setq p3 (list (car p2) (cadr p1) (caddr p1)))

(command "move" ss "" p1 p3)

(princ)

)

(defun c:my ()

(setq ss (ssget))

(setq p1 (getpoint "\n基点:"))

(setq p2 (getpoint "\n第二点:"))

(setq p3 (list (car p1) (cadr p2) (caddr p1)))

(command "move" ss "" p1 p3)

(princ)

)

(defun c:cx ()

(setq ss (ssget))

(setq p1 (getpoint "\n基点:"))

(setq p2 (getpoint "\n第二点:"))

(setq p3 (list (car p2) (cadr p1) (caddr p1)))

(command "copy" ss "" p1 p3)

(princ)

)

(defun c:cy ()

(setq ss (ssget))

(setq p1 (getpoint "\n基点:"))

(setq p2 (getpoint "\n第二点:"))

(setq p3 (list (car p1) (cadr p2) (caddr p1)))

(command "copy" ss "" p1 p3)

(princ)

)

《==移动复制程序

以下为自定义函数:

_____________________________________________________________________________

((setvar 'measurement 1))

(defun sztc1 () 自动设置图层函数==>>

(setq l1 "0"

l2 "1中心线"

l3 "2粗实线"

l4 "3细实线"

l5 "4剖面线"

l6 "5虚线"

l7 "6标注"

l8 "7轮廓线"

) 设置图层名称

(setq c1 33

c2 1

c3 7

c4 6

c5 2

c6 4

c7 40

c8 5

) 设置图层颜色

(setq lt1 "Continuous"

lt2 "CENTER2"

lt3 "Continuous"

lt4 "Continuous"

lt5 "Continuous"

lt6 "DASHED2"

lt7 "Continuous"

lt8 "Dividex2"

) 设置图层线形

(setq lw1 0.13

lw2 0.13

lw3 0.30

lw4 0.13

lw5 0.13

lw6 0.13

lw7 0.13

lw8 0.13

) 设置图层线宽

(command "-linetype" "l" "center2"

"")

(command "-linetype" "l" "dashed2"

"")

(command "-linetype" "l"

"acad_is005w100" "")

(command "-layer" "n" l1 "c" c1 l1 "l" lt1 l1 "lw" lw1 l1 "")

(command "-layer" "n" l2 "c" c2 l2 "l" lt2 l2 "lw" lw2 l2 "")

(command "-layer" "n" l3 "c" c3 l3 "l" lt3 l3 "lw" lw3 l3 "")

(command "-layer" "n" l4 "c" c4 l4 "l" lt4 l4 "lw" lw4 l4 "")

(command "-layer" "n" l5 "c" c5 l5 "l" lt5 l5 "lw" lw5 l5 "")

(command "-layer" "n" l6 "c" c6 l6 "l" lt6 l6 "lw" lw6 l6 "")

(command "-layer" "n" l7 "c" c7 l7 "l" lt7 l7 "lw" lw7 l7 "")

(command "-layer" "n" l8 "c" c8 l8 "l" lt8 l8 "lw" lw8 l8 "")

(princ "\n图层设置完毕!")

(princ)

)

<<==自动设置图层函数

(defun szbz1 () 设置标注样式

(setvar 'dimadec 0) 角度小数位数

(setvar 'dimalt 0) 选定的换算单位

(setvar 'dimaltd 3) 换算单位小数位数

(setvar 'dimaltf 0.0394) 换算单位比例因子

(setvar 'dimaltrnd 0) 换算单位舍入值

(setvar 'dimalttd 3) 换算公差小数位数

(setvar 'dimalttz 0) 换算公差消零

(setvar 'dimaltu 2) 换算单位

(setvar 'dimaltz 0) 换算单位消零

(setvar 'dimapost "") 替换文字的前缀和后缀

(setvar 'dimarcsym 0) 弧长符号

(setvar 'dimasz 2.5) 箭头大小

(setvar 'dimatfit 3) 箭头和文字调整

(setvar 'dimaunit 0) 角度单位格式

(setvar 'dimazin 2) 角度消零

(setvar 'dimblk "") 箭头块名

(setvar 'dimblk1 "") 第一个箭头块名

(setvar 'dimblk2 "") 第二个箭头块名

(setvar 'dimcen 3) 圆心标记大小

(setvar 'dimclrd 0) 尺寸线和引线颜色

(setvar 'dimclre 0) 尺寸界线颜色

(setvar 'dimclrt 0) 标注文字颜色

(setvar 'dimdec 2) 小数位数

(setvar 'dimdle 0) 尺寸线

(setvar 'dimdli 3.75) 尺寸线间距

(setvar 'dimdsep ".") 小数分隔符

(setvar 'dimexe 1.25) 尺寸界线在尺寸线上

(setvar 'dimexo 0) 尺寸界线原点偏移

(setvar 'dimfrac 0) 分数格式

(setvar 'dimfxl 1) 固定的尺寸界线

(setvar 'dimfxlon 0) 启用固定的尺寸界线

(setvar 'dimgap 0.625) 尺寸线和文字的间距

(setvar 'dimjogang 46)

半径标注折弯角度

(setvar 'dimjust 0) 尺寸线上的文字对正

(setvar 'dimldrblk "") 引线块名

(setvar 'dimlim 0) 生成标注界限

(setvar 'dimltex1 ".") 线型尺寸界线 1

(setvar 'dimltex2 ".") 线型尺寸界线 2

(setvar 'dimltype ".") 标注线型

(setvar 'dimlunit 2) 线性单位格式

(setvar 'dimlwd -2) 尺寸线和引线线宽

(setvar 'dimlwe -2) 尺寸界线线宽

(setvar 'dimpost "") 标注文字的前缀和后缀

(setvar 'dimrnd 0) 舍入值

(setvar 'dimsah 0) 独立的箭头块

(setvar 'dimscale 1) 全局比例因子

(setvar 'dimsd1 0) 隐藏第一条尺寸线

(setvar 'dimsd2 0) 隐藏第二条尺寸线

(setvar 'dimse1 0) 隐藏第一条尺寸界线

(setvar 'dimse2 0) 隐藏第二条尺寸界线

(setvar 'dimsoxd 0) 隐藏外侧尺寸线

(setvar 'dimtad 1) 文字位于尺寸线上方

(setvar 'dimtdec 2) 公差小数位数

(setvar 'dimtfac 1) 公差文字高度比例因子

(setvar 'dimtfill 0) 文字背景已启用

(setvar 'dimtfillclr 0) 文字背景颜色

(setvar 'dimtih 0) 尺寸界线内侧的文字水平放置

(setvar 'dimtix 0) 将文字放置于尺寸界线内侧

(setvar 'dimtm 0) 下偏差

(setvar 'dimtmove 0) 文字移动

(setvar 'dimtofl 1) 强制在尺寸界线内侧画尺寸线

(setvar 'dimtoh 1) 外侧文字水平放置

(setvar 'dimtol 0) 公差标注

(setvar 'dimtolj 0) 公差垂直对齐

(setvar 'dimtp 0) 上偏差

(setvar 'dimtsz 0) 标记大小

(setvar 'dimtvp 0) 文字垂直位置

(setvar 'dimtxt 3.5) 文字高度

(setvar 'dimtzin 8) 公差消零

(setvar 'dimupt 0) 用户定位的文字

(setvar 'dimzin 8) 消零

(command "-style" "1 长仿宋体" "gbeitc.shx,gbcbig.shx"

"" "0.7" "" ""

""

)

(setvar 'dimtxsty "1 长仿宋体") 标注文字样式

(setq n (getreal "\n尺寸比例?<1>"))

(if (= n nil)

(setvar 'dimlfac 1)

(setvar 'dimlfac n)

) 线性单位比例因子

(command "-dimstyle" "s" "1 长仿宋体标注")

(princ)

)


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12303401.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-24
下一篇 2023-05-24

发表评论

登录后才能评论

评论列表(0条)

保存