偏移变色lisp_直线偏移联动 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
本帖最后由 masterlong 于 2018-11-4 15:08 编辑
;|
类似于edata发布的程序“直线偏移连动~偏移后修改与其相接触的直线”
和他不同的是
edata的程序需要先指定偏移距离,再选择直线,最后指定偏移方向
而我的程序是
先选择参照直线,再选择偏移目标点,直接计算出偏移距离
如果两头都有【同层】线相连,那么参照直线执行偏移
如果仅一头有线相连,那么偏移同时,改变直线到偏移目标点
由于我的应用环境,需要进行如上操作的都是互相垂直的线,所以没加入斜角相交延伸的功能
|;
(vl-load-com)
;;命令是OLL ————话说,论坛能设置成屏蔽“字母组合自动转表情”吗????
(defun c
ll()
(if (setq ss (ssget":E:S" '((0 . "line"))))
(progn
(command "undo" "g")
(ssdraw ss 3)
(setq pickpt (last (last (car (ssnamex ss))))) ;;选取点
(setq line (ssname ss 0))
(setq lay (dxf 8 line))
(setq p10 (dxf 10 line))
(setq p11 (dxf 11 line))
(if (< (distance p10 pickpt) (distance p11 pickpt))
(setq pa p10 pb p11)
(setq pa p11 pb p10)
)
(zooment line 2)
(setq ss1 (ssget "F" (list p10 p11) (list '(0 . "line") (cons 8 lay))))
(setq ss1 (ss2list ss1))
(setq ss1 (vl-remove line ss1))
(command "_.zoom" "p")
(ssdraw ss1 3)
(if (setq pc (getpoint pa "\n指定偏移点: "))
(progn
(setq yn (vl-remove-if-not ''((one) (or (equal (distance (dxf 10 one) pa) 0 5) (equal (distance (dxf 11 one) pa) 0 5))) ss1))
(do_offset)
)
)
(ssdraw ss 4)
(ssdraw ss1 4)
(command "undo" "e")
(c
ll)
)
)
(princ)
)
(defun do_offset()
(setq ang (angle pa pc))
(setq dist (distance pa pc))
(setq pd (polar pb ang dist))
(setq pd (per_po pb pc pd))
(if yn
(setq pc (per_po pa pc pd))
)
(entmodone line 10 pc)
(entmodone line 11 pd)
;|
(setq pa (list (car pa) (cadr pa)))
(setq pb (list (car pb) (cadr pb)))
(setq pc (list (car pc) (cadr pc)))
(setq pd (list (car pd) (cadr pd)))
|;
(foreach linef ss1
(setq pm (dxf 10 linef)
pn (dxf 11 linef)
)
;;(setq pm (list (car pm) (cadr pm)))
;;(setq pn (list (car pn) (cadr pn)))
(setq px (inters pa pb pm pn NIL))
(cond
((equal (distance pm px) 0 5) (setq dxfnm 10))
((equal (distance pn px) 0 5) (setq dxfnm 11))
( T (setq dxfnm NIL))
)
(setq px (inters pc pd pm pn NIL))
(if (and px dxfnm)
(entmodone linef dxfnm px)
)
)
)
;;公共函数
;999获取图元某个dxf组码
(defun dxf( ent n / temp )
(if (and (= (type ent) 'int) (= (type n) 'ename))
(setq temp ent
ent n
n temp
)
)
(cdr (assoc n (entget ent)))
)
;999按指定的模式重画一个选择集的全部物体4=1->2->4)> 【支持模型多视口,支持布局中视口】
;; 1:显示 2:消隐 3:高亮 4:低亮
(defun ssdraw( ss mode / i ent )
(if (= (strcase (getvar "ctab")) "MODEL")
(if (member mode '(1 2 3 4))
(foreach vp (reverse (vports))
(setvar "cvport" (car vp))
(cond
((= (type ss) 'PICKSET)
(foreach ent (ss2list ss)
(redraw ent mode)
)
)
((= (type ss) 'list)
(foreach ent ss
(redraw ent mode)
)
)
((= (type ss) 'ename)
(redraw ss mode)
)
)
)
)
(cond
((= (type ss) 'PICKSET)
(foreach ent (ss2list ss)
(redraw ent mode)
)
)
((= (type ss) 'list)
(foreach ent ss
(redraw ent mode)
)
)
((= (type ss) 'ename)
(redraw ss mode)
)
)
)
(princ)
)
;999以指定图元缩放窗口
(defun zooment( ent sc / box x midpo )
(setq *acad* (vlax-get-acad-object))
(setq box (entbox ent))
(setq midpo (getmidpo box))
(setq box (mapcar '(lambda (x) (p0_sc_p1 midpo x sc)) box))
(vla-zoomwindow *acad* (vlax-3d-point (car box)) (vlax-3d-point (cadr box)))
box
)
;999以基点p0缩放p1————P0为缩放基点
(defun p0_sc_p1 (p0 p1 sc )
(polar p0 (angle p0 p1) (* sc (distance p0 p1)))
)
;999修改一个图元的某个数据 ——————不是所有的图元都适用此方式
(defun entmodone( ent dxfnum data )
(entmod (list (cons -1 ent)(cons dxfnum data)))
)
;999一点到另两点形成直线的垂足
(defun per_po( p1 p2 p3 / ang ptemp )
(setq ang (angle p2 p3))
(setq ang (+ ang (/ PI 2)))
(setq ptemp (polar p1 ang 1000))
(inters p1 ptemp p2 p3 nil)
)
漏了一些子函数见7楼
偏移变色lisp_直线偏移联动 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...相关推荐
- 方孔分段的lisp_常用函数.lsp - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
本帖最后由 自贡黄明儒 于 2013-11-11 12:57 编辑 ;;各位,把你们收藏都拿出秀一秀呀,放在箱底会生霉的 ;;我的收集是在caoyin发布的通用函数基础上扩展的----自贡黄明儒 20 ...
- cad四边形展开lisp_批量绘制四边形 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
;试用以下程序 (defun c:test() (setq bcsjb '(("A1" 9549.31 6977.53 7180.75 7155.97 11015.11) (&qu ...
- cad偏移后自动变色lisp_高手帮忙修改,批量偏移 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
;;用LISP实现将PL环向内或向外偏移 ;;http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=654 (defun C:TEE ( / cu ...
- 偏移变色lisp_渐进式 多重偏移,见图片效果 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - 偏移 - Powered by Discuz!...
本帖最后由 荒野孤行 于 2015-6-23 19:28 编辑 渐进式多重偏移,图片效果如下: 附上源码: ;;; *****多重偏移 程序开始***** (defun c:dcpy () (setv ...
- cad抛物线曲线lisp_曲线的转弯半径和曲率 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
;;;============================================================= ;;; 一般平面曲线参数方程的曲率离心公式 ;;; 功能: 获取曲线上 ...
- cad线段总和lisp_求一个线段长度总和与生成文本 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
像这种 ;;;;;计算面积,周长.显视在图面上 (defun C:am (/ s text1 text2 ss l i totalarea ename obj insertpt insertpt1) ...
- 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_快速填充的多选问题 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
本帖最后由 alexmai 于 2019-3-22 00:35 编辑 ----------------------------------------------------------------- ...
- 块内拉升lisp_多重插入块的炸开问题? - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz!...
很多个cad文件,被别人加了密,每个cad文件都生成了很多个多重插入块,在论坛找了个xxi的程序,可以炸开多重插入块,但是,文件太多,块也太多,不能一个一个炸,而且,每个多重插入块执行一下xxi命令之 ...
最新文章
- activity重启问题
- 【正一专栏】读《艾思奇哲学文选第六卷》
- 【django】类视图
- Serverless 解惑——函数计算如何安装字体
- 【NLP】Transformer自注意机制代码实现
- Java【前端动态添加一条记】【后端使用JDK1.8实现map对象根据key的部分值进行分组】(并将map对象封装成指定entity对象)
- Identityserver4中ResourceOwnerPassword 模式获取refreshtoken
- Android之版本检测和更新
- matlab7.0编辑运行,手把手解答win10系统运行matlab7.0时提示Runtime error的操作方案
- 那些年踩过的eleUl上传图片的坑?
- C/C++线程与多线程工作笔记0005---c/c++中的wchar_t类型
- 改动Xmodem/Zmodem上传下载路径
- SpringBoot之HelloWorld
- IIS7下访问ashx页面,显示404
- linux 查看内存和cup使用率
- 我们建立数据中心,需要考虑哪些问题?
- JMP系列-基础操作(一)
- Python 中的关键字with详解
- 揭开神秘的莫比乌斯环异形创意LED显示屏的柔性显示之美。
- 《未来简史》--读后感
热门文章
- Vue中使用vue-video-player视频播放器
- IMAP协议定时监听接收邮件(QQ邮箱、网易邮箱都可)
- kali Linux升级后问题一大堆,Kali linux 2020 常见问题的解决方法(持续更新)
- Java实现简单的日历小程序之Java图形界面开发小日历
- 网络攻防——Goby+AWVS漏洞扫描
- 作为前端,如何帮帝都的朋友租到合适的房子
- Python:每日一题之四平方和
- 升级jdk版本后,出现SecurityException: JCE cannot authenticate the provider BC
- 注册申请PayPal支付账户
- 手把手系列之四十七—手把手教你做奶白鲫鱼汤