刀路连接，源码 有需要的朋友拿去随便改，随便用

雨的节奏

刀路连接

2. (defun c:WW (/ os olddix pt1 pt2 ptlist angx ptlistx ptlists enx ss ss2)
   
3.   (setvar "cmdecho" 0)
   
4.   (setq os (getvar "osmode"))
   
5.   (setvar "osmode" 0)
   
6.   (if (null DIX)
   
7.   (setq DIX (getdist "\n请输入要连接的距离:"))
   
8.   (progn
   
9.       (setq OLDDIX DIX
   
10.             DIX (getreal (strcat "输入要连接的距离<"(rtos OLDDIX 2 4)">")))
    
11.             (if (null DIX) (setq DIX OLDDIX))
    
12.    )
    
13.   )
    
14.   (while (setq pt1 (getpoint "\n输入第一点"))
    
15.          (setq pt2 (getpoint pt1 "\n输入下一点"))
    
16.   (command "._undo" "begin")
    
17.   (setq ptlist (list pt1 pt2)
    
18.         angx (angle pt1 pt2))
    
19.   (setq ptlistx
    
20.         (mapcar '(lambda (x) (polar x (+ (/ pi 2) angx) DIX)) ptlist))
    
21.   (setq ptlistx (reverse ptlistx))
    
22.   (setq ptlists (append ptlist ptlistx))
    
23.   (command "pline") (mapcar 'command ptlists) (command "c")
    
24.   (setq enx (entlast))
    
25.   (setq ss (ssget "f" ptlistx))
    
26.   (setq ss (ssadd enx ss))
    
27.   (command "region" ss "")
    
28.   (setq ss (ssget "f" ptlistx))
    
29.   (command "union" ss "")
    
30.   (setq eny (entlast))
    
31.   (command "explode" eny)
    
32.   (setq ss2 (ssget "p"))
    
33.   (setvar "PEDITACCEPT" 1)
    
34.   (command "PEDIT" ss2  "j" "all" "" "")
    
35.   (setvar "PEDITACCEPT" 0)
    
36.   (command "._undo" "end")
    
37.   );end while
    
38. (setvar "osmode" os)
    
39. (princ "\n完成连线操作")
    
40. (prin1)
    
41. )
    
42. 
    

(defun c:WW (/ os olddix pt1 pt2 ptlist angx ptlistx ptlists enx ss ss2)<br />   (setvar "cmdecho" 0)<br />   (setq os (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (if (null DIX)<br />   (setq DIX (getdist "\n请输入要连接的距离:"))<br />   (progn <br />       (setq OLDDIX DIX<br />             DIX (getreal (strcat "输入要连接的距离<"(rtos OLDDIX 2 4)">")))<br />             (if (null DIX) (setq DIX OLDDIX))<br />    )<br />   )<br />   (while (setq pt1 (getpoint "\n输入第一点"))<br />          (setq pt2 (getpoint pt1 "\n输入下一点"))<br />   (command "._undo" "begin")<br />   (setq ptlist (list pt1 pt2)<br />         angx (angle pt1 pt2))<br />   (setq ptlistx <br />         (mapcar '(lambda (x) (polar x (+ (/ pi 2) angx) DIX)) ptlist))<br />   (setq ptlistx (reverse ptlistx))<br />   (setq ptlists (append ptlist ptlistx))<br />   (command "pline") (mapcar 'command ptlists) (command "c")<br />   (setq enx (entlast))<br />   (setq ss (ssget "f" ptlistx))<br />   (setq ss (ssadd enx ss))<br />   (command "region" ss "")<br />   (setq ss (ssget "f" ptlistx))<br />   (command "union" ss "")<br />   (setq eny (entlast))<br />   (command "explode" eny)<br />   (setq ss2 (ssget "p"))<br />   (setvar "PEDITACCEPT" 1)<br />   (command "PEDIT" ss2  "j" "all" "" "")<br />   (setvar "PEDITACCEPT" 0)<br />   (command "._undo" "end")<br />   );end while<br /> (setvar "osmode" os)<br /> (princ "\n完成连线操作")<br /> (prin1)<br /> ) <br /> <br />

前生

纵横八方 发表于 2019-6-21 22:05
断开 的线 能连起来  就牛逼了  面域的方法有漏洞

断开的线，用pedit连接有时候都会出问题。加上现在有很多同志出的图纸，不敢恭维。
有些图用3D软件画完后，在转成2D档，就更让人崩溃了。
一直想重新写个LISP版的pedit ,选择线，弧，通过计算，点列表，用entmake的方法生成pline.

纵横八方

我们水刀行业的插件 就 能把断开的 连接起来，只支持两个图元直接的连接，基本上没有bug

水仙的错

Application Error: 0 :- 输入中的点位置不正确ADS 请求错误、
这个怎么回事？？

yoyoho

谢谢! 雨的节奏 分享程序!!!!!

ynhh

看上很牛啊
不知是用来干什么的

心中的梦想

虽然用不上，但还是谢谢分享

纵横八方

漂亮，水刀正需要

纵横八方

断开 的线 能连起来  就牛逼了  面域的方法有漏洞

ysq101

哇。还是原码。。
收下了，谢谢楼主无私分享

石井鱼

平时好像用不到，还是感谢楼主无私

烟盒迷唇

还是不知道是做什么的