cad引出线段lisp_利用lisp给CAD直线取整?
回答:
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 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_利用lisp给CAD直线取整?相关推荐
- cad引出线段lisp_给定起终点,如何提取线段连线关系表 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
(defun c:tt (/ l i s p e r a d o ) (setq r 2.0 ) : 设定字体比列参数 1:2 (if (and (setq e (car (entsel " ...
- cad引出线段lisp_lisp将多条线条合并成一条多段线
该楼层疑似违规已被系统折叠 隐藏此楼查看此楼 (defun c:pljoin(/ #os1 ss i en ent ss1 xlist ent_pt_list pt_list l_pt l_pt_li ...
- 天正引出标注lisp_怎样让天正CAD沿曲线走向来标注文字
天正AutoCAD实现沿曲线走向标注文字并不方便,为此天正开发了相关命令--txtpl,这里演示用该命令让文字基于已有多段线(pline)的走向进行排布的方法.特别指出,这一命令只能基于用pl命令绘制 ...
- cad幕墙下料lisp_幕墙公司使用CAD制图标准
- 1 - 1. 范围 本标准规定了深远幕墙集团内部进行 CAD 制图的基本要求. 本标准仅适用于深远幕墙集团内部 CAD 制图. 2. 引用标准 下列标准所包含的条文通过在本标准中引用,而构成为本标 ...
- 天正lisp文件夹_天正启动时加载那些lisp_怎么在启动CAD时自动加载Lisp的工具和插件...
怎么在启动 CAD 时自动加载 Lisp 的工具和插件 网上有很多非常有用的 CAD 插件, 能给绘图带来很多便利. 这些 工具手动加载后就可以执行, 但每次用的时候都要加载挺麻烦的, 能 不能在启动 ...
- 天正启动时加载那些lisp_怎么在启动CAD时自动加载Lisp的工具和插件?
原标题:怎么在启动CAD时自动加载Lisp的工具和插件? 网上有很多非常有用的CAD插件,能给绘图带来很多便利.这些工具手动加载后就可以执行,但每次用的时候都要加载挺麻烦的,能不能在启动软件的时候把自 ...
- 天正启动时加载那些lisp_怎么在启动CAD时自动加载Lisp的工具和插件
怎么在启动 CAD 时自动加载 Lisp 的工具和插件 网上有很多非常有用的 CAD 插件, 能给绘图带来很多便利. 这些 工具手动加载后就可以执行, 但每次用的时候都要加载挺麻烦的, 能 不能在启动 ...
- 天正启动时加载那些lisp_怎么在启动CAD时自动加载Lisp的工具及插件
怎么在启动CAD时自动加载Lisp的工具及插件 网上有很多非常有用的CAD插件,手动加载后就可以执行,但每次用的时候都要加载挺麻烦的,能不能在启动软件的时候把自己常用的插件加载进来? 方法1:添加到启 ...
- 天正启动时加载那些lisp_天正启动时加载那些lisp_启动CAD时自动加载Lisp的工具和插件的方法?...
互联网上有许多非常有用的CAD插件,可以为绘图带来很多便利. 这些工具可以在手动加载后执行,但是每次使用它们都麻烦. 启动软件时,您可以加载常用插件吗? 当然,有不止一种方法. 方法1:添加到启动组 ...
最新文章
- mac -- 安装OpenCV
- 【c++】14.编译proto和proto相关用法
- Vi编辑器的使用方法
- RabbitMQ之TTL(Time-To-Live 过期时间)
- mysql中show属于_mysql show的常见用法
- 《源码分析转载收藏向—数据库内核月报》
- 记录java 疑难杂症
- c++new时赋初值_C++ Lesson 7:new,delete amp; 类的重用
- 浏览器窗口可视区域大小相关方法
- php虚拟机java虚拟机,Java虚拟机的具体详解
- 最牛逼android上的图表库MpChart(三) 条形图
- mysql 修改前缀_批量修改mysql的表前缀
- 完全卸载迈克菲Mcafee的工具
- c语言char str什意思,char *str与*str的区别
- Android禁止view上下滑动,Android RecyclerView禁止滑动
- 【图片浏览器 Objective-C语言】
- html网页播放器编辑代码大全
- 女学霸考692分想当“程序媛”,女生到底要不要学计算机?
- 搭建cocos2d-x-android环境 Windows XP3 + Eclipse + NDKR7(或ndkr7b)+COCOS2DX(没有用到cygwin和minigw)
- JavaScript操作摄像头指南