如何让不交的线的端点自动相交

citykunan

谢谢龙班主提供的新方法，但是正像你所说的，當對物縮至很少時,(ssget "c" PT10 PT10)還是會選到不在點上的物件，这样就不能trim和extend了。我们的图纸都很大，不知如何是好了，总觉得程序很好，但使用有局限性，就很遗憾了。不知有没有办法改良？


不过还是真心地谢谢你。

f5612140

(command "zoom" "c" px 100)


.....


(command "zoom" "p")


.

无痕

不能有更好的办法了么？


我写一个试试

无痕

3. (defun c:xl-tr (/ cmd ss r e lst)   (princ "\nc:xl-tr = 自动焊接曲线端头－－－－－－－－－无痕.2004.2")
4.    (vl-load-com)
5.    (vl-cmdf ".undo" "be")
6.    (setq cmd (getvar "cmdecho")
7.   pkb (getvar "pickbox")
8.   os   (getvar "osmode"))
9.    (setvar "cmdecho" 0)
10.    (setvar "osmode" 0)
11.    (setq pt1 (getpoint "\n两点框选焊接实体:")
12.   pt2 (getcorner pt1 "\n第二点:")
13.                ss (ssget "w" pt1 pt2 '((0 . "*polyline,line,ellipse,arc")))
14.   r   (getdist "\n焊接容许误差:"))
15.    (vl-cmdf ".zoom" "w" pt1 pt2)
16.    (setvar "pickbox" 0)
17.    (repeat (setq n (sslength ss))
18.        (setq e   (ssname ss (setq n (1- n)))
19.      lst(append lst (list (xl-ept e T))(list (xl-ept e nil)))
20.        )
21.    )
22.    (foreach m lst (x@tr m))
23.    (setvar "osmode" os)
24.    (setvar "pickbox" pkb)
25.    (setvar "cmdecho" cmd)
26.    (vl-cmdf "zoom" "p" ".undo" "e")
27. )
29. (defun xl-ept (e key / obj pt)
30.    (setq obj (vlax-ename->vla-object e)
31.   pt   (cond
32.              ((member (cdr (assoc 0 (entget e))) '("LINE" "ARC" "ELLIPSE"))
33.                (if key(vlax-get obj 'startpoint)(vlax-get obj 'endpoint)))
34.              (T (vlax-curve-getpointatparam obj
35.          (if key (vlax-curve-getstartparam obj)(vlax-curve-getendparam obj))))
36.          )
37.    )(list e pt)
38. )
40. (defun x@tr (ept / maxpt minpt ss2)
41.    (setq maxpt (polar (cadr ept) (* 0.25 PI) (* 1.414 r))
42.   minpt (polar (cadr ept) (* 1.25 PI) (* 1.414 r))
43.   ss2     (ssget "c" minpt maxpt '((0 . "*polyline,line,ellipse,arc"))))
44.    (vl-cmdf ".extend" ss2 "" ept "")
45.    (vl-cmdf ".trim" ss2 "" ept "")
46. )

(defun c:xl-tr (/ cmd ss r e lst)   (princ "\nc:xl-tr = 自动焊接曲线端头－－－－－－－－－无痕.2004.2")    (vl-load-com)    (vl-cmdf ".undo" "be")    (setq cmd (getvar "cmdecho")   pkb (getvar "pickbox")   os   (getvar "osmode"))    (setvar "cmdecho" 0)    (setvar "osmode" 0)    (setq pt1 (getpoint "\n两点框选焊接实体:")   pt2 (getcorner pt1 "\n第二点:")                ss (ssget "w" pt1 pt2 '((0 . "*polyline,line,ellipse,arc")))   r   (getdist "\n焊接容许误差:"))    (vl-cmdf ".zoom" "w" pt1 pt2)    (setvar "pickbox" 0)    (repeat (setq n (sslength ss))        (setq e   (ssname ss (setq n (1- n)))      lst(append lst (list (xl-ept e T))(list (xl-ept e nil)))        )    )    (foreach m lst (x@tr m))    (setvar "osmode" os)    (setvar "pickbox" pkb)    (setvar "cmdecho" cmd)    (vl-cmdf "zoom" "p" ".undo" "e") ) (defun xl-ept (e key / obj pt)    (setq obj (vlax-ename->vla-object e)   pt   (cond              ((member (cdr (assoc 0 (entget e))) '("LINE" "ARC" "ELLIPSE"))                (if key(vlax-get obj 'startpoint)(vlax-get obj 'endpoint)))              (T (vlax-curve-getpointatparam obj          (if key (vlax-curve-getstartparam obj)(vlax-curve-getendparam obj))))          )    )(list e pt) ) (defun x@tr (ept / maxpt minpt ss2)    (setq maxpt (polar (cadr ept) (* 0.25 PI) (* 1.414 r))   minpt (polar (cadr ept) (* 1.25 PI) (* 1.414 r))   ss2     (ssget "c" minpt maxpt '((0 . "*polyline,line,ellipse,arc"))))    (vl-cmdf ".extend" ss2 "" ept "")    (vl-cmdf ".trim" ss2 "" ept "") )

无痕

测试图原图（运行程序时候即此视窗）



       


容差值（最大断距）=200, 运行后效果：


       





此版本不支持两边缺角，因此单元右下角有一个缺角，下一个版本用求交点法支持。


经测试，对line，arc，ellipse支持较好，对*polyline成功率不高。

无痕

呵呵，v1.1a 测试较为满意版又出来了。



全面支持line，arc，ellipse，lwpolyline （可惜对spline裁减方便，但是要支持延伸程序要另外加一大块，因此决定暂时不支持）





此版本修正了一些bug，如曲线与另外曲线有两个交点时候裁减延伸不规律bug（大家看测试图可见，上部右边的样例为未修正前的效果，下面的阵列为修正程序后执行效果，但在同一个容差范围内端点既能伸又能剪的情况，未加以处理，有待改进），较好的支持pline，支持L型缺角。虽然如此，程序还是存在一些bug，主要是处理曲线交点的地方！


请看测试图：这个图打开后的显示即是测试时候执行程序所用的窗口。这次残酷的测试使用了多个单元阵列，每个单元包含多种可能出现的断口情况，实体包括line，arc，ellipse，lwpolyline。





测试程序下载：（rar格式，解压后为 vlx 格式文件，加载后用 xtr 命令执行）

kaixin119

把原码让我看看好吗,测试多麻烦啊,几下就不能用了

meflying

kaixin119发表于2004-2-7 9:20:00把原码让我看看好吗,测试多麻烦啊,几下就不能用了

似乎给你看了源码用处不大啊，有要改动的，你还不是要叫别人来改

f5612140

哈哈!我也克服了這個問題,不用"zoom",將pickbox=0可以得到正確結果,多謝無痕的提醒

ljcgq

我写了一个程序但是怎么也调试不好,不知道那里有问题,希望斑竹能给我修改一下... (defun c:qq(/)
(setq cd (getreal "请输入距离"))
(setq ss (ssget '((0 . "line"))))
(setq n (sslength ss))
(setq i (1- n))
(repeat n
(setq name0 (ssname ss i))
(setq name0entget (entget name0))
(setq qd0 (cdr (assoc 10 name0entget ))
zd0 (cdr (assoc 11 name0entget ))
ang (angle qd0 zd0)
qd1 (polar qd0 (+ ang (/ pi 2)) cd)
zd1 (polar zd0 (+ ang (/ pi 2)) cd)
qd2 (polar qd0 (- ang (/ pi 2)) cd)
zd2 (polar zd0 (- ang (/ pi 2)) cd)
)
(setq ss1 (ssget "c" qd1 zd1 ))
(setq ss2 (ssget "c" qd2 zd2 ))
(setq n2 (sslength ss2))
(repeat n2
(ssadd (ssname ss2 (1- n2)) ss1)
(setq n2(1- n2))
)


(setq n1 (sslength ss1))
(setq j (1- n1))
(repeat n1
(setq namex (ssname ss1 j))
(setq namexentget (entget namex))
(setq qdx (cdr (assoc 10 namexentget ))
zdx (cdr (assoc 11 namexentget ))
)
(cond
( (and (/= (inters qdx zdx qd1 zd1) nil)
(/= (inters qdx zdx qd0 zd0) nil)
(= (inters qdx zdx qd2 zd2) nil)
)
(command "break" namex "f" qd0 qd2 "" )
)
( (and (= (inters qdx zdx qd1 zd1) nil)
(/= (inters qdx zdx qd0 zd0) nil)
(/= (inters qdx zdx qd2 zd2) nil)
)
(command "break" namex "f" qd0 qd1 "" )
)
)
(setq j (1- j))
)
(command "EXTEND" name0 "" "f" qd1 zd1 "" "f" qd2 zd2 "" "")
(command)
(setq i(1- i))
)
)