框选直线段，一次性剪切延伸

Andyhon · 发表于 2010-12-25 08:33

理了下思路
依线组求出交点集
排序交点集
切割回路绘出方框
清除圆内的线段

xiaxiang · 发表于 2010-12-25 08:45

拜托了

twingo18 · 发表于 2010-12-26 00:34

下載試用看先

xiaxiang · 发表于 2010-12-26 16:35

刚找到一段代码，不知适不适用，见笑了

;命令：tat（可自己修改）
;用途：将弧线和批量直线的交点按照顺序用直线连接
;程序思路：找交点，交点排序，画直线
;应用范围: r12以上acad
;编写采用：Lisplink16.02
;cbreak_0是寻找圆弧和直线端点pa,pb的交点
(defun cbreak_0 (ent pa pb)
(setq pt1 nil
pt2 nil
)
(setq pc (cdr (assoc 10 ENT)))
(setq rc (cdr (assoc 40 ENT)))
(setq anglestart (cdr (assoc 50 ent)))
(setq angleend (cdr (assoc 51 ent)))
(if (< (- angleend anglestart) 0)
(setq angleend (+ angleend (* 2 3.1415926535898)))
)
(setq angleab (angle pa pb))
(setq angleab90 (+ angleab (/ 3.1415926536 2)))
(setq angleab180 (+ angleab 3.1415926536))
(setq angleab270 (+ angleab (* 3.1415926536 1.5)))
(setq pd (polar pc angleab90 rc))
(setq pf (polar pc angleab270 rc))
(setq virtualpa (polar pa angleab180 1000000))
(setq virtualpb (polar pb angleab 1000000))
(setq pe (inters
virtualpa
virtualpb
pf
pd
)
)
(if pe
(progn
(setq l1 (distance pc pe))
(setq l2 (sqrt (- (* rc rc) (* l1 l1))))
(setq la (distance pc pa))
(setq lb (distance pc pb))
(if (and
(>= la rc)
(>= lb rc)
)
(progn
(setq pac (polar pe angleab180 l2))
(setq pbc (polar pe angleab l2))
(setq pabr (distance pa pb))
(setq par1 (distance pac pa))
(setq par2 (distance pac pb))
(setq par3 (distance pbc pa))
(setq par4 (distance pbc pb))
(if (and (<= par1 pabr) (<= par2 pabr) (<= par3 pabr) (<= par4 pabr))
(setq pt1 pac pt2 pbc))
)
)
(if (and
(< la rc)
(>= lb rc)
)
(progn
(setq pbc (polar pe angleab l2))
(setq pt1 nil
pt2 pbc
)
)
)
(if (and
(>= la rc)
(< lb rc)
)
(progn
(setq pac (polar pe angleab180 l2))
(setq pbc pb)
(setq pt1 pac
pt2 nil
)
)
)
(if (and
(< la rc)
(< lb rc)
)
(progn
(setq pt1 nil
pt2 nil
)
)
)
)
)
(setq pt1temp pt1
pt2temp pt2
)
(setq pt1 nil
pt2 nil
)
(if (/= pt1temp nil)
(progn
(setq anglept1c (angle pc pt1temp))
(if (and
(>= anglept1c anglestart)
(<= anglept1c angleend)
)
(setq pt1 pt1temp)
)
(setq anglept1c_a (+ anglept1c (* 3.1415926535 2)))
(if (and
(>= anglept1c_a anglestart)
(<= anglept1c_a angleend)
)
(setq pt1 pt1temp)
)
)
)
(if (/= pt2temp nil)
(progn
(setq anglept2c (angle pc pt2temp))
(if (and
(>= anglept2c anglestart)
(<= anglept2c angleend)
)
(setq pt2 pt2temp)
)
(setq anglept2c_a (+ anglept2c (* 3.1415926535 2)))
(if (and
(>= anglept2c_a anglestart)
(<= anglept2c_a angleend)
)
(setq pt2 pt2temp)
)
)
)
)
;jiaohuan1是交换表中两个数据的位置
(defun jiaohuan1 (az bz)
(setq qqqz (nth az pee))
(setq pqqqz (nth bz pee))
(setq pee (subst
'(xxxxxx)
(nth az pee)
pee
)
)
(setq pee (subst
'(yyyyyy)
(nth bz pee)
pee
)
)
(setq pee (subst
qqqz
(nth bz pee)
pee
)
)
(setq pee (subst
pqqqz
(nth az pee)
pee
)
)
)
;tat是主程序
(defun c:tat ()
(princ "请选择包含弧线的选择集，自动过滤剩下弧线：")
(setq SSet1 (ssget))
(princ "请选择包含直线的选择集，自动过滤剩下直线：")
(setq SSet2 (ssget))
;过滤第一选择集
(setq i 0)
(setq ss1 (ssadd))
(while (< i (sslength sset1))
(setq ln (ssname sset1 i))
(if (= "ARC" (cdr(assoc 0(entget ln))))
(ssadd ln ss1)
)
(setq i(1+ i))
)
;过滤第二选择集
(setq i 0)
(setq ss2 (ssadd))
(while (< i (sslength sset2))
(setq ln (ssname sset2 i))
(if (= "LINE" (cdr(assoc 0(entget ln))))
(ssadd ln ss2)
)
(setq i(1+ i))
)
(setq iarc 0)
(setq lenarc (sslength ss1))
(while (< iarc lenarc)
(setq BENT1 (entget (ssname SS1 iarc)))
(setq obj1 (cdr (assoc 0 bent1)))
(setq itm2 0
num2 (sslength ss2)
)
(setq pee nil
pe nil
)
(while (< itm2 num2)
(setq BENT2 (entget (ssname SS2 itm2)))
(setq obj2 (cdr (assoc 0 bent2)))
(setq PA (cdr (assoc 10 BENT2))
PB (cdr (assoc 11 BENT2))
)
;寻找交点
(cbreak_0 bent1 pa pb)
;交点入表
(if (= itm2 0)
(progn
(if (/= pt1 nil)
(setq pee (list pt1))
)
(if (/= pt2 nil)
(setq petemp (list pt2)
pee (append
pee
petemp
)
)
)
)
)
(if (/= itm2 0)
(progn
(if (/= pt1 nil)
(setq pe (list pt1)
pee (append
pee
pe
)
)
)
(if (/= pt2 nil)
(setq pe (list pt2)
pee (append
pee
pe
)
)
)
)
)
(setq itm2 (1+ itm2))
)
;交点排序
(setq i 0)
(setq num22 (length pee))
(while (< i (- num22 1))
(setq j (+ 1 i))
(while (< j num22)
(setq pee1 (nth i pee))
(setq inte1 (angle pc pee1))
(if (< inte1 anglestart)
(setq inte1 (+ inte1 (* 3.1415926535 2)))
)
(setq pee2 (nth j pee))
(setq inte2 (angle pc pee2))
(if (< inte2 anglestart)
(setq inte2 (+ inte2 (* 3.1415926535 2)))
)
(setq hehe (- inte2 inte1))
(if (< hehe 0)
(progn
(jiaohuan1 i j)
)
)
(setq j (+ j 1))
)
(setq i (+ 1 i))
)
;交点画线
(setq i 0)
(setq num22 (length pee))
(while (< i (- num22 1))
(setq pee1 (nth i pee))
(setq pee2 (nth (1+ i) pee))
(command "line" pee1 pee2 "")
(setq i (1+ i))
)
(setq iarc (1+ iarc))
)
)

;命令：tat（可自己修改） 
;用途：将弧线和批量直线的交点按照顺序用直线连接 
;程序思路：找交点，交点排序，画直线 
;应用范围: r12以上acad 
;编写采用：Lisplink16.02 
 
;cbreak_0是寻找圆弧和直线端点pa,pb的交点 
(defun cbreak_0 (ent pa pb) 
(setq pt1 nil 
pt2 nil 
) 
(setq pc (cdr (assoc 10 ENT))) 
(setq rc (cdr (assoc 40 ENT))) 
(setq anglestart (cdr (assoc 50 ent))) 
(setq angleend (cdr (assoc 51 ent))) 
(if (< (- angleend anglestart) 0) 
(setq angleend (+ angleend (* 2 3.1415926535898))) 
) 
(setq angleab (angle pa pb)) 
(setq angleab90 (+ angleab (/ 3.1415926536 2))) 
(setq angleab180 (+ angleab 3.1415926536)) 
(setq angleab270 (+ angleab (* 3.1415926536 1.5))) 
(setq pd (polar pc angleab90 rc)) 
(setq pf (polar pc angleab270 rc)) 
(setq virtualpa (polar pa angleab180 1000000)) 
(setq virtualpb (polar pb angleab 1000000)) 
(setq pe (inters 
virtualpa 
virtualpb 
pf 
pd 
) 
) 
(if pe 
(progn 
(setq l1 (distance pc pe)) 
(setq l2 (sqrt (- (* rc rc) (* l1 l1)))) 
(setq la (distance pc pa)) 
(setq lb (distance pc pb)) 
 
(if (and 
(>= la rc) 
(>= lb rc) 
) 
(progn 
(setq pac (polar pe angleab180 l2)) 
(setq pbc (polar pe angleab l2)) 
(setq pabr (distance pa pb)) 
(setq par1 (distance pac pa)) 
(setq par2 (distance pac pb)) 
(setq par3 (distance pbc pa)) 
(setq par4 (distance pbc pb)) 
(if (and (<= par1 pabr) (<= par2 pabr) (<= par3 pabr) (<= par4 pabr)) 
(setq pt1 pac pt2 pbc)) 
) 
) 
(if (and 
(< la rc) 
(>= lb rc) 
) 
(progn 
(setq pbc (polar pe angleab l2)) 
(setq pt1 nil 
pt2 pbc 
) 
) 
) 
(if (and 
(>= la rc) 
(< lb rc) 
) 
(progn 
(setq pac (polar pe angleab180 l2)) 
(setq pbc pb) 
(setq pt1 pac 
pt2 nil 
) 
) 
) 
(if (and 
(< la rc) 
(< lb rc) 
) 
(progn 
(setq pt1 nil 
pt2 nil 
) 
) 
) 
) 
) 
 
 
(setq pt1temp pt1 
pt2temp pt2 
) 
(setq pt1 nil 
pt2 nil 
) 
(if (/= pt1temp nil) 
(progn 
(setq anglept1c (angle pc pt1temp)) 
(if (and 
(>= anglept1c anglestart) 
(<= anglept1c angleend) 
) 
(setq pt1 pt1temp) 
) 
(setq anglept1c_a (+ anglept1c (* 3.1415926535 2))) 
(if (and 
(>= anglept1c_a anglestart) 
(<= anglept1c_a angleend) 
) 
(setq pt1 pt1temp) 
) 
) 
) 
 
(if (/= pt2temp nil) 
(progn 
 
(setq anglept2c (angle pc pt2temp)) 
 
(if (and 
(>= anglept2c anglestart) 
(<= anglept2c angleend) 
) 
(setq pt2 pt2temp) 
) 
(setq anglept2c_a (+ anglept2c (* 3.1415926535 2))) 
 
 
(if (and 
(>= anglept2c_a anglestart) 
(<= anglept2c_a angleend) 
) 
(setq pt2 pt2temp) 
) 
) 
) 
 
 
) 
 
 
;jiaohuan1是交换表中两个数据的位置 
(defun jiaohuan1 (az bz) 
(setq qqqz (nth az pee)) 
(setq pqqqz (nth bz pee)) 
(setq pee (subst 
'(xxxxxx) 
(nth az pee) 
pee 
) 
) 
(setq pee (subst 
'(yyyyyy) 
(nth bz pee) 
pee 
) 
) 
(setq pee (subst 
qqqz 
(nth bz pee) 
pee 
) 
) 
(setq pee (subst 
pqqqz 
(nth az pee) 
pee 
) 
) 
) 
 
;tat是主程序 
(defun c:tat () 
(princ "请选择包含弧线的选择集，自动过滤剩下弧线：") 
(setq SSet1 (ssget)) 
(princ "请选择包含直线的选择集，自动过滤剩下直线：") 
(setq SSet2 (ssget)) 
;过滤第一选择集 
(setq i 0) 
(setq ss1 (ssadd)) 
(while (
(setq ln (ssname sset1 i)) 
(if (= "ARC" (cdr(assoc 0(entget ln)))) 
(ssadd ln ss1) 
) 
(setq i(1+ i)) 
) 
 
;过滤第二选择集 
(setq i 0) 
(setq ss2 (ssadd)) 
(while (
(setq ln (ssname sset2 i)) 
(if (= "LINE" (cdr(assoc 0(entget ln)))) 
(ssadd ln ss2) 
) 
(setq i(1+ i)) 
) 
 
(setq iarc 0) 
(setq lenarc (sslength ss1)) 
(while (< iarc lenarc) 
(setq BENT1 (entget (ssname SS1 iarc))) 
(setq obj1 (cdr (assoc 0 bent1))) 
(setq itm2 0 
num2 (sslength ss2) 
) 
(setq pee nil 
pe nil 
) 
(while (< itm2 num2) 
(setq BENT2 (entget (ssname SS2 itm2))) 
(setq obj2 (cdr (assoc 0 bent2))) 
(setq PA (cdr (assoc 10 BENT2)) 
PB (cdr (assoc 11 BENT2)) 
) 
 
;寻找交点 
(cbreak_0 bent1 pa pb) 
 
;交点入表 
(if (= itm2 0) 
(progn 
(if (/= pt1 nil) 
(setq pee (list pt1)) 
) 
(if (/= pt2 nil) 
(setq petemp (list pt2) 
pee (append 
pee 
petemp 
) 
) 
) 
 
 
) 
) 
(if (/= itm2 0) 
(progn 
(if (/= pt1 nil) 
(setq pe (list pt1) 
pee (append 
pee 
pe 
) 
) 
) 
 
(if (/= pt2 nil) 
(setq pe (list pt2) 
pee (append 
pee 
pe 
) 
) 
) 
 
) 
) 
(setq itm2 (1+ itm2)) 
) 
 
;交点排序 
(setq i 0) 
(setq num22 (length pee)) 
(while (
(setq j (+ 1 i)) 
(while (< j num22) 
(setq pee1 (nth i pee)) 
(setq inte1 (angle pc pee1)) 
(if (< inte1 anglestart) 
(setq inte1 (+ inte1 (* 3.1415926535 2))) 
) 
(setq pee2 (nth j pee)) 
(setq inte2 (angle pc pee2)) 
(if (< inte2 anglestart) 
(setq inte2 (+ inte2 (* 3.1415926535 2))) 
) 
(setq hehe (- inte2 inte1)) 
(if (< hehe 0) 
(progn 
(jiaohuan1 i j) 
) 
) 
(setq j (+ j 1)) 
) 
(setq i (+ 1 i)) 
) 
 
;交点画线 
(setq i 0) 
(setq num22 (length pee)) 
(while (
(setq pee1 (nth i pee)) 
(setq pee2 (nth (1+ i) pee)) 
(command "line" pee1 pee2 "") 
(setq i (1+ i)) 
) 
(setq iarc (1+ iarc)) 
) 
)

xiaxiang · 发表于 2010-12-28 17:34

Andyhon ，不知做的怎么样，等候您的佳音！

Andyhon · 发表于 2011-1-7 12:04

思路不同重新改写...
通过在2004下 Email_5.TC-CC 样例上图调试
Email_5.TC-CC 上图全框选

xiaxiang · 发表于 2011-1-7 14:05

苦苦等待许多年,感谢Andyhon 大侠,先试用一下

xiaxiang · 发表于 2011-1-7 14:30

非常感谢,程序做到这个地步,已经非常不容易了

唯一的缺憾,是执行完一次后,当圆再次被移动位置,再运行test,报出没有任何对象被选中---"命令输入时发送的类型无效".经分析,应是某些单线被连接成多线的缘故.因此手动explode之后,再选择test,则成功.
请问大侠,干脆在程序中加入先explode再test?
不过我自己手动也可以的.不论如何,表示衷心的感谢.

戏男 · 发表于 2011-9-9 10:02

这只能争对这种图吗换另一种也能行不

longer1000 · 发表于 2011-9-9 14:35

使用一下，只针对直线且是正交的可以使用

账号		自动登录	找回密码
密码			注册

框选直线段，一次性剪切延伸

本帖子中包含更多资源

本帖子中包含更多资源