直线偏移联动
本帖最后由 masterlong 于 2018-11-4 15:08 编辑;|
类似于edata发布的程序“直线偏移连动~偏移后修改与其相接触的直线”
和他不同的是
edata的程序需要先指定偏移距离，再选择直线，最后指定偏移方向
而我的程序是
先选择参照直线，再选择偏移目标点，直接计算出偏移距离
如果两头都有【同层】线相连，那么参照直线执行偏移
如果仅一头有线相连，那么偏移同时，改变直线到偏移目标点
由于我的应用环境，需要进行如上操作的都是互相垂直的线，所以没加入斜角相交延伸的功能
|;
(vl-load-com)
;;命令是OLL ————话说，论坛能设置成屏蔽“字母组合自动转表情”吗？？？？
(defun c:oll()
(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 p10pb p11)
(setq pa p11pb 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 ss4)
(ssdraw ss1 4)
(command "undo" "e")
(c:oll)
)
)
(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 tempent
ent n
ntemp
)
)
(cdr (assoc n (entget ent)))
)
;999按指定的模式重画一个选择集的全部物体<改模式时，需要先反绘。1-2 3-4.(1->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楼
谢谢! masterlong 分享程序!!!!! 建议发压缩文件包 知道edata说的方法
但是论坛以前还好
点“复制代码”
整个代码就复制下来了
粘贴也很正常
现在操作就全部变成了一行
所以就很不喜欢用这个功能了
不过后来发现
可以先点“普通浏览”
在弹出窗口里全选复制
少了一些函数 ssyfeng 发表于 2018-11-4 14:19
少了一些函数
;;;选集转图元名表
;;;(ss2list (SSGET))
;;;(<图元名称: 7ef14230> <图元名称: 7ef14228> <图元名称: 7ef14220>)
(defun ss2list ( ss / i l )
(if ss
(repeat (setq i (sslength ss))
(setq l (cons (ssname ss (setq i (1- i))) l))
)
)
)
;;By Longxin 明经通道 2005.06
;;取得实体外矩形框
;;例：(entbox 图元名)
;;返回：((x1 y1 z1)_min (x2 y2 z2)_max)
;;(entbox (CAR(ENTSEL)))
(defun entbox (e1 / obj minpoint maxpoint)
(setq obj (vlax-ename->vla-object e1)) ;转换图元名
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
;取得包容图元的最大点和最小点
(setq minpoint (vlax-safearray->list minpoint)) ;把变体数据转化为表
(setq maxpoint (vlax-safearray->list maxpoint)) ;把变体数据转化为表
;;(command "box" minpoint maxpoint 2)
(setq obj (list minpoint maxpoint))
)
;;; ----------------------- getmidpo --------------------------
;;; 两点之中点
;;;方式 : (setq pt3 (getmidpo LST))
;;;LST为表,且为两个点的点表,如:((528762.0 6045.65 0.0) (530541.0 8015.43 0.0))
(defun getmidpo (LST)
(list (/ (+ (CAR (NTH 0 LST)) (CAR (NTH 1 LST))) 2)
(/ (+ (cadr (NTH 0 LST)) (cadr (NTH 1 LST))) 2)
(/ (+ (caddr (NTH 0 LST)) (caddr (NTH 1 LST))) 2)
)
) 本帖最后由 masterlong 于 2018-11-4 15:41 编辑
谢谢yoyoho
贴上我的子函数
;999公共函数
;;选择集转为图元列表
(defun ss2list ( ss / n i elist )
(cond
((= (type ss) 'Pickset)
(setq n(sslength ss)
i n
elist '()
)
(repeat n
(setq i (1- i))
;;如果没有这个if，那么选择集中被删除的图元，也会被加入到列表之中————但是极其偶尔也有可能，图元不存在但是能entget（遇到过一次，原因不明，或许是CAD的BUG）
(if (entget (ssname ss i))
(setq elist (cons (ssname ss i) elist))
)
)
elist
)
((= (type ss) 'ename)
(list ss)
)
((= (type ss) 'list)
(vl-remove-if-not ''((x) (and (= (type x) 'ename) (entget x))) ss)
)
( T NIL)
)
)
;999单个物体的最小（正交）包围框---------------------------------这个程序在遇到无法显示的图元时，还是会出错的，比如形。天正图元会不会也不支持，未测试
(defun entbox ( ent / ll ur )
(vla-getboundingbox (vlax-Ename->Vla-Object ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;999公共函数
;;求点对中点
(defun getmidpo( pts / P1 P2 X Y )
(setq p1 (car pts) p2 (cadr pts))
(if (= (length p1) (length p2))
nil
(setq p1 (list (car p1) (cadr p1))
p2 (list (car p2) (cadr p2))
)
)
(mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)
谢谢! masterlong 分享子函数!!!!
masterlong 发表于 2018-11-4 13:31
知道edata说的方法
但是论坛以前还好
点“复制代码”
在代码区的第一个字符点一下，按shift点代码区最后一个字符，就能选择该区域的文字，复制粘贴就带lisp格式了。或者手动拖动选择也可以。。
页:
[1]