cad抠图 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文字高度 : "))
(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))
)
(setq
pp2 (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共删除红色图元个")
))
(command "UNDO" "E")
(princ) )
这样,键入 D1 命令,就可以删除红色的图元了。
cad抠图 lisp_五个实用的AutoCAD的lisp程序相关推荐
- cad抠图 lisp_用Autolisp对AutoCAD进行二次改造
刚开始工作时候,经常使用 AutoCAD2002 设计, 制作标题栏.画粗糙度符号是一个重复性的工作 而 CAD 到又没有提供相关的命令可以让我们的操作一步到位,很不方便 于是,我就利用在学校里所学的 ...
- cad零点坐标标注lisp_CAD XY坐标标注AUTO LISP程序
CAD X,Y 坐标坐标标注 AUTO LISP 程序 ;; (DEFUN IDPT(/ p px py pxx pyy) (DEFUN IDPT () (SETQ X T) (WHILE X (SE ...
- CAD自控lisp_CAD里面自动画管线图地LISP程序
画一些管路原理图时,当代表不同管路的直线在图中相交时,需将在交点处的某一直线断开,再用一半圆连接两断点,使用下面这个LISP编写的程序,只用键入"brel"的命令,其它的就由电脑去 ...
- cad尺寸文字避让lisp_CAD批量修改文字角度lisp程序
(DEFUN C:chhang () (princ "\nselect object:") (setq s (ssget)) (setq hig (getreal "\n ...
- Python五种实用的小技巧
本文经"机器之心"授权,禁止二次转载. 作者:Peter Nistru 机器之心编译 参与:思 最开始学 Python 时,如果我能掌握这些方法,那么代码看起来会更加优美. 在本文 ...
- 企业要做好安全遵从的五个实用技巧
本文讲的是企业要做好安全遵从的五个实用技巧,如今在很多的企业或组织中,数据安全和规范管理已经成为一个很重要的问题,虽然企业制定了很多需要遵守的规范和准则,但数据泄漏和安全威胁依然来势汹汹,它们在IT治 ...
- 天正对应cad版本_天正CAD提示找不到可用的AutoCAD版本怎么办? - CAD自学网
很多设计行业的童鞋换了新电脑后,新电脑安装的是64位的vista或win7.win8.win10,轻车熟路地安装了AutoCAD2008和天正8,一切准备OK准备打开天正8大干一番事业的时候,突然发现 ...
- 提升工作效率的五款实用工具软件及其应用心得
本文介绍了五款实用的工具软件,包括Microsoft Office Suite.Adobe Creative Suite.GitHub.Slack和Zoom,并详细阐述了它们的应用场景.能解决的问题和 ...
- 办公资源分享:五个实用的在线网站
在线网站可以帮助我们省去下载软件的时间,只需要打开网页,我们即可快速完成我们工作当中需要完成的一些操作.因此我们只需要知道一些实用的在线网站,就可以大大的提高我们的工作效率,接下来就是办公资源分享:五 ...
- CAD的使用群体有哪些?AutoCAD对业余小白来说友好吗?
随着计算机行业的蓬勃发展,很多朋友选择在近几年里投入计算机设计与运用的学习之中,作为广泛应用于土木建筑.装饰装潢.电子机械设计.服装鞋帽.轻工化工等诸多领域的辅助制图软件系统,CAD都是谁在使用?如果 ...
最新文章
- oracle linux vs centos我们选择谁
- python二维表转一维表_Excel、Power BI及Python系列:使用Power BI转化一维表与二维表...
- Python输出黄金分隔数列前n项。 黄金分隔数列由Fibonacci数列相邻两项之比组成:1/1,1/2,2/3,3/5,5/8,...其取值逐渐接近黄金分隔数。
- 还在到处集五福?支付宝其实埋了一个鲜为人知的集福利器!
- .NetCore下使用Polly结合IHttpClientFactory实现聚合服务
- python提取高频词_seo与python大数据结合给文本分词并提取高频词
- 华北水利水电大学c语言实验报告八2020,2021年华北水利水电大学级C语言实验报告.doc...
- vscode调试Flutter
- Error:Cannot find module 'stylus'
- 操作系统—基本知识(细致版)
- 理解mini-batch、Momentum、RMSpror、Admin优化算法
- 算法笔记_面试题_20.数组相关_模板及示例十几道
- crunch 生成密码用例
- SC-RoadDeepNet学习笔记
- 2021-11-25 使用kali自带的SET工具制作钓鱼网站
- 手把手教你领取永久免费服务器
- 人类的历史就是一部创业史
- c语言简单快速排序原理,快速排序原理、复杂度分析及C语言实现
- Git删除提交历史记录
- VIBE运动目标检测算法实现