CAD LISP 程序.docx
- 文档编号:23649204
- 上传时间:2023-05-19
- 格式:DOCX
- 页数:8
- 大小:15.68KB
CAD LISP 程序.docx
《CAD LISP 程序.docx》由会员分享,可在线阅读,更多相关《CAD LISP 程序.docx(8页珍藏版)》请在冰豆网上搜索。
CADLISP程序
1.计算所有线段总长度(加载后只需框选所有线段便可得出这些线段的总长度)
(defunc:
LL()
(setvar"cmdecho"1)
(setqen(ssget(list'(0."spline,arc,line,ellipse,LWPOLYLINE"))))
(setqi0)
(setqll0)
(repeat(sslengthen)
(setqss(ssnameeni))
(setqendata(entgetss))
(command"lengthen"ss"")
(setqdd(getvar"perimeter"))
(setqll(+ddll))
(setqi(1+i))
)
(princ"所选线条总长为:
")(princll)(princ)
)
2.标注所有线段(加载后只需框选所有线段便可得标注这些线段)
(defunc:
LLL()
(COMMAND"UCS""")
(setvar"cmdecho"1)
(SETVAR"OSMODE"0)
(setq AcadObject (vlax-get-acad-object)
AcadDocument(vla-get-ActiveDocumentAcadobject)
mSpace (vla-get-ModelSpaceAcaddocument)
)
;;选取需要测量的样条曲线、圆弧、直线、椭圆
(setqen(ssget(list'(0."spline,arc,line,ellipse,LWPOLYLINE"))))
(setqi0)
;;获取系统参数textsize
(setqshh(getvar"textsize"))
(setqstr_hh(strcat"\n文字高度<"(rtosshh2)">:
"))
(setqhh(getdiststr_hh))
(whilehh
(setvar"textsize"hh)
(setqhhnil))
;;输入标注文字高度
;;循环开始
(repeat(sslengthen)
(setqss(ssnameeni))
(setqendata(entgetss))
(command"lengthen"ss"")
(setqdd(getvar"perimeter"))
(princ(strcat"\n长度="(rtosdd2)))
;;寻找代表图层的字符串
(setqaa(assoc0endata))
;;获取图层名称
(setqaa1(cdraa))
;;判断线条种类
(cond
((=aa1"SPLINE")
;;如果是spline
(progn
(setqarcObj(VLAX-ENAME->VLA-OBJECTss))
(setqstartPnt1(vla-get-ControlPointsarcObj))
(setqp1
(vlax-safearray->list(vlax-variant-valuestartPnt1))
)
(setqx1(carp1))
(setqy1(cadrp1))
(setqz1(caddrp1))
(setqpp1(listx1y1z1))
(repeat(-(/(lengthp1)3)1)
;;循环,寻找最后一个控制点
(setqp1(cdddrp1))
(setqx2(carp1))
(setqy2(cadrp1))
(setqz2(caddrp1))
)
(setqpp2(listx2y2z2))
)
)
((=aa1"LWPOLYLINE")
;;如果是LWPOLYLINE
(progn
(setqarcObj(VLAX-ENAME->VLA-OBJECTss))
(setqstartPnt1(vla-get-CoordinatesarcObj))
(setqp1
(vlax-safearray->list(vlax-variant-valuestartPnt1))
)
(setqx1(carp1))
(setqy1(cadrp1))
(setqz1(caddrp1))
(setqpp1(listx1y1z1))
(repeat(-(/(lengthp1)3)1)
;;循环,寻找最后一个控制点
(setqp1(cdddrp1))
(setqx2(carp1))
(setqy2(cadrp1))
(setqz2(caddrp1))
)
(setqpp2(listx2y2z2))
)
)
(t
;;如果是其他种类线条
(progn
(setqarcObj(VLAX-ENAME->VLA-OBJECTss))
(setqstartPnt1(vla-get-StartPointarcObj))
;;获取起点
(setqendPnt1(vla-get-EndPointarcObj))
;;获取终点
(setqpp1
(vlax-safearray->list(vlax-variant-valuestartPnt1))
)
(setq
pp2(vlax-safearray->list(vlax-variant-valueendPnt1))
)
)
)
)
(setqx1(carpp1))
(setqy1(cadrpp1))
(setqz1(caddrpp1))
(setqx2(carpp2))
(setqy2(cadrpp2))
(setqz2(caddrpp2))
(setqx(/(+x1x2)2))
(setqy(/(+y1y2)2))
(setqz(/(+z1z2)2))
(setqpt(listxyz))
;;取得线段两端的中点
(setqang(anglepp1pp2))
;;获取角度
(if (>(*(/angpi)180)180)
(setqang(+angpi))
)
(command"text"
"j"
"bc"
pt
""
(*(/angpi)180)
(strcat""(rtosdd2))
""
)
(setqi(1+i))
)
(prin1)
)
(prompt"\n<>在图中直接写出长度")
(prin1)
3.连续打断程序
(defunc:
br1()
(command"break"pause"f"pause"@")
)
4.将CAD文字导入Excel表格
(defunc:
Q2()
(setqffn(getfiled"写出文件""""xls"1))
(princ"\n选取文字...")
(setqss(ssget))
(setqff(openffn"w"))
(setqi0)
(repeat(sslengthss)
(setqssn(ssnamessi))
(setqssdata(entgetssn))
(setqsstyp(cdr(assoc0ssdata)))
(if(or(=sstyp"TEXT")(=sstyp"MTEXT"))
(progn
(setqtxt(cdr(assoc1ssdata)))
(princtxtff)
(princ"\n"ff)
)
)
(setqi(1+i))
)
(closeff)
(princ(strcat"\n写出文件:
"ffn))
(prin1)
)
5删除带颜色图元
以下程序在别人的贴子里贴过.为了说明问题,今天再贴一次.
改颜色的LISP程序
(defunc:
c1()(ssget)(command"chprop""p""""c""1""")(princ))
(defunc:
c2()(ssget)(command"chprop""p""""c""2""")(princ))
(defunc:
c3()(ssget)(command"chprop""p""""c""3""")(princ))
(defunc:
c4()(ssget)(command"chprop""p""""c""4""")(princ))
(defunc:
c5()(ssget)(command"chprop""p""""c""5""")(princ))
(defunc:
c6()(ssget)(command"chprop""p""""c""6""")(princ))
(defunc:
c7()(ssget)(command"chprop""p""""c""7""")(princ))
(defunc:
c8()(ssget)(command"chprop""p""""c""8""")(princ))
你用C1命令就可以将图元改为红色了.其余类似.
删除红色图元
(defunC:
D1(/mAM)
(setqm:
err*error**error**merr*)
(setvar"cmdecho"0)
(command"UNDO""G")
(prompt"选择图形")
(setqA(ssget'((62.1))))
(if(/=Anil)(progn
(setqM(sslengthA))
(command"erase"A"")
(princ"\n共删除红色图元<")(princM)(princ">个")
))
(command"UNDO""E")
(princ) )
这样,键入D1命令,就可以删除红色的图元了.
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- CAD LISP 程序