连接成多段线

/db_自贡黄明儒_ · 发表于 2017-6-27 14:17:17

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 /db_自贡黄明儒_ 于 2017-6-27 14:18 编辑

;; 转成多段线
;;为了autocad2004,多段线联接代码如下

(defun C:DDX (/ PET SS fil)
(setq pet (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(setq fil '((-4 . "<or")
(0 . "ARC,LINE")
(-4 . "<AND")
(0 . "*POLYLINE")
(70 . 0)
(-4 . "AND>")
(-4 . "or>")
)
)
;;不能有封闭多段线
(while (setq ss (ssget fil))
(APPLY 'command (list "_pedit" (ssname ss 0) "_j" ss "" ""))
(princ "\n......已经转换成多段线，继续？？？......")
)
(setvar "PEDITACCEPT" pet)
(princ)
)

有谁知道jion命令是从哪个版本开始的？其有联接多段线、overkill特点外，还增加了其它特点。

q3_2006 · 发表于 2017-6-27 14:21:46

jion..2006起

ll_j · 发表于 2017-6-27 20:40:49

早期的join命令似乎没有现在的好用，上网查了一下，似乎早期的join对直线、圆弧等，必须共线才行，但现在的版本已经是框选，包括首尾相连的各种线形及共线的直线、圆弧、椭圆等。
相比较join和pedit的join选项，两者各有的特点是，join可以合并如椭圆、样条曲线等，这是pedit所不能的，但pedit的join可以设置模糊距离，这也是join办不到的。

使用pedit命令连接线条，你的程序有一点是需要完善，在使用ssname取得连接“源”后，使用命令可以连接所有和这个“源”线条依次首尾相连的线条，但另外一些和这些线条并不首尾相连（或三通）的线条则会被排除在外，而这些线条相互之间有可能存在首尾相连关系，所以，仅仅依次连接是不够的。

/db_自贡黄明儒_ · 发表于 2017-6-27 21:50:14

本帖最后由 /db_自贡黄明儒_ 于 2017-6-27 22:07 编辑

ll_j 发表于 2017-6-27 20:40

1 确实，一次只多生成一个多段线，经使用发现够用。至于您说的怎么使用ssname,不知怎么弄。
2 想在高版本(> (atof (getvar 'acadver)) 16.1)时，改为(command "join" (ssget) "")不行了。以往在命令行怎么敲就怎么写，这次不行了。

ll_j · 发表于 2017-6-27 22:37:29

第一个问题比较简单，就是对选择集“遍历”一下，每次join以后，剔除这个实体，再对剩下的选择集重复...
第二个问题好像就复杂了，使用command函数调用的似乎是低版本的join，而命令行的join似乎是经过处理的join。

/db_自贡黄明儒_ · 发表于 2017-6-28 08:50:22

ll_j 发表于 2017-6-27 22:37

1 (command "join" (ssget) "")不行，而手动输入行，说明这个选择集容器是不同的东西？
2 模糊距离是很小的数值，多远的线也能连接起来，是怎么回事？

(defun C:DDX (/ E FIL L N PET SS X)
(setq pet (getvar "PEDITACCEPT"))
(setvar "PEDITACCEPT" 1)
(setq fil '((-4 . "<or")
(0 . "ARC,LINE")
(-4 . "<AND")
(0 . "*POLYLINE")
(70 . 0)
(-4 . "AND>")
(-4 . "or>")
)
)
;;不能有封闭多段线
(while (setq ss (ssget fil))
(repeat (setq n (sslength ss))
(setq e (ssname ss (setq n (1- n))))
(setq L (cons e L))
)
(if (>= (atof (getvar 'acadver)) 16.1);05版及以上
(progn
(setq x (VL-PRINC-TO-STRING (/ (getvar 'viewsize) 100000)))
(APPLY 'command (list ".pedit" "m" ss "" "j" "j" "b" x ""))
)
(foreach x L
(if (entget x)
(APPLY 'command (list "_pedit" (ssname ss 0) "_j" ss "" ""))
)
)
)
(princ "\n......已经转换成多段线，继续？？？......")
)
(setvar "PEDITACCEPT" pet)
(princ)
)

(defun C:DDX (/ E FIL L N PET SS X) 
  (setq pet (getvar "PEDITACCEPT")) 
  (setvar "PEDITACCEPT" 1) 
  (setq        fil '((-4 . "<or") 
              (0 . "ARC,LINE") 
              (-4 . "<AND") 
              (0 . "*POLYLINE") 
              (70 . 0) 
              (-4 . "AND>") 
              (-4 . "or>") 
             ) 
  ) 
  ;;不能有封闭多段线 
  (while (setq ss (ssget fil)) 
    (repeat (setq n (sslength ss)) 
      (setq e (ssname ss (setq n (1- n)))) 
      (setq L (cons e L))      
    ) 
    (if        (>= (atof (getvar 'acadver)) 16.1);05版及以上 
      (progn 
        (setq x (VL-PRINC-TO-STRING (/ (getvar 'viewsize) 100000))) 
        (APPLY 'command (list ".pedit" "m" ss "" "j" "j" "b" x "")) 
      ) 
      (foreach x L 
        (if (entget x) 
          (APPLY 'command (list "_pedit" (ssname ss 0) "_j" ss "" "")) 
        ) 
      ) 
    ) 
    (princ "\n......已经转换成多段线，继续？？？......") 
  ) 
  (setvar "PEDITACCEPT" pet) 
  (princ) 
)

lzy1979 · 发表于 2017-6-28 09:28:32

bucuod e

9635luyu · 发表于 2017-6-28 10:17:59

这么多的连接转换多段线程序，还是下面这个最给力，速度最快，比cad本身的命令要快，但是有一个缺点选择对象好象有一定的限制不能太多，否则出错，还有就是不能选择多段线，合并之后图层也变了，不知哪位大神能改改就完美了，代码如下：
;代码纯手打,不容易,如果你有拷贝此副本,请保留此项.;LISP 聚合程序.;BY Urings.;2016.11.22.
(defun |xxyyzz (un isd fuzz / an1 an2 cen crs dcr
dseb ent eser esz l len n newc newo
nsebs pls pt1 pt2 rad untp xx yy zz
 )
 (defun xx (** fuzz / are areis ari arr arris
 ars arsis dsn len n pid pidc pide
 pidis pidn pidnis pxs x**
 )
(setq len (1- (length **)))
(or (minusp len)
(setq ars (vlax-make-safearray 2 (cons 0 len))
 are (vlax-make-safearray 2 (cons 0 len))
 arr (list ars are)
 arsis (vlax-make-safearray 2 (cons 0 len))
 areis (vlax-make-safearray 2 (cons 0 len))
 arris (list arsis areis)
 ari (vlax-make-safearray 2 (cons 0 len))
)
)
(setq pid -1)
(foreach n **
 (setq pid (1+ pid))
 (setq pxs (cons (list (car (car n)) (cadr (car n)) pid 0) pxs))
 (setq pxs (cons (list (car (cadr n)) (cadr (cadr n)) pid 1) pxs))
 (vlax-safearray-put-element ars pid -1)
 (vlax-safearray-put-element are pid -1)
 (vlax-safearray-put-element arsis pid -1)
 (vlax-safearray-put-element areis pid -1)
)
(vl-sort pxs
 (function
 (lambda (e1 e2)
 (if (equal (car e1) (car e2) fuzz)
 (if (equal (cadr e1) (cadr e2) fuzz)
 (progn (if (zerop (cadddr e1))
 (progn (vlax-safearray-put-element
 ars
 (caddr e1)
 (caddr e2)
 )
 (vlax-safearray-put-element
 arsis
 (caddr e1)
 (cadddr e2)
 )
 )
 (progn (vlax-safearray-put-element
 are
 (caddr e1)
 (caddr e2)
 )
 (vlax-safearray-put-element
 areis
 (caddr e1)
 (cadddr e2)
 )
 )
 )
 (if (zerop (cadddr e2))
 (progn (vlax-safearray-put-element
 ars
 (caddr e2)
 (caddr e1)
 )
 (vlax-safearray-put-element
 arsis
 (caddr e2)
 (cadddr e1)
 )
 )
 (progn (vlax-safearray-put-element
 are
 (caddr e2)
 (caddr e1)
 )
 (vlax-safearray-put-element
 areis
 (caddr e2)
 (cadddr e1)
 )
 )
 )
 t
 )
 (< (cadr e1) (cadr e2))
 )
 (< (car e1) (car e2))
 )
 )
 )
)
(repeat (setq len (1+ len))
 (and
(/= -1 (vlax-safearray-get-element ari (setq len (1- len))))
(progn
 (setq pid len)
 (setq pidis 0)
 (setq pidc pid)
 (setq pide (vlax-safearray-get-element are pid))
 (setq dsn (list (list pid pidis)))
 (while
 (and
 (/= -1 pid)
 (/= -1 pidis)
 (/= -1
 (setq pidn
 (vlax-safearray-get-element (nth pidis arr) pid)
 )
 )
 (/= -1
 (setq pidnis (vlax-safearray-get-element
 (nth pidis arris)
 pid
 )
 )
 )
 (= pid (vlax-safearray-get-element (nth pidnis arr) pidn))
 )
 (vlax-safearray-put-element ars pid -1)
 (vlax-safearray-put-element are pid -1)
 (vlax-safearray-put-element ari pid -1)
 (setq pid pidn)
 (setq pidis (- 1 pidnis))
 (setq dsn (cons (list pid pidis) dsn))
 )
 (vlax-safearray-put-element ars pid -1)
 (vlax-safearray-put-element are pid -1)
 (vlax-safearray-put-element ari pid -1)
 (setq pid pidc)
 (vlax-safearray-put-element are pid pide)
 (setq pidis 1)
 (setq dsn (reverse dsn))
 (while
 (and
 (/= -1 pid)
 (/= -1 pidis)
 (/= -1
 (setq pidn
 (vlax-safearray-get-element (nth pidis arr) pid)
 )
 )
 (/= -1
 (setq pidnis (vlax-safearray-get-element
 (nth pidis arris)
 pid
 )
 )
 )
 (= pid (vlax-safearray-get-element (nth pidnis arr) pidn))
 )
 (vlax-safearray-put-element ars pid -1)
 (vlax-safearray-put-element are pid -1)
 (vlax-safearray-put-element ari pid -1)
 (setq dsn (cons (list pidn pidnis) dsn))
 (setq pid pidn)
 (setq pidis (- 1 pidnis))
 )
 (vlax-safearray-put-element ars pid -1)
 (vlax-safearray-put-element are pid -1)
 (vlax-safearray-put-element ari pid -1)
 (setq dsn (cons (list pid pidis) dsn))
 (setq pxs nil)
 (foreach n dsn
 (setq pxs (cons (cons (cadr n) (nth (car n) **)) pxs))
 )
 (setq x** (cons pxs x**))
)
 )
)
x**
 )
 (defun yy (** fuzz / len m n pl plbul plcs ple pler plis plos)
(foreach n **
 (setq pl nil)
 (foreach m n
(setq plbul (cadddr m))
(or (zerop (car m)) (setq plbul (- plbul)))
(setq pl (cons (cons 42 plbul)
 (cons (cons 10 (nth (1+ (car m)) m)) pl)
 )
)
 )
 (setq plis 0)
 (setq len (length n))
 (and (equal (cadr pl) (last pl) fuzz)
 (setq plis 1
 pl (cddr pl)
 len (1- len)
 )
 )
 (or (and (> len 1)
 (setq ple (entmakex (append (list '(0 . "LWPOLYLINE")
 '(100 . "AcDbEntity")
 '(100 . "AcDbPolyline")
 (cons 90 len)
 (cons 70 plis)
 )
 (reverse pl)
 '((210 0. 0. 1.))
 )
 )
 )
 (if (zerop plis)
 (setq plos (cons ple plos))
 (setq plcs (cons ple plcs))
 )
 )
 (setq pler (cons pl pler))
 )
)
(list plcs plos pler)
 )
 (defun zz (crx / e es eser n)
(foreach n crx
 (or (and (setq e (entmakex (list '(0 . "CIRCLE")
 '(100 . "AcDbEntity")
 '(100 . "ACDbCircle")
 (cons 10 (car n))
 (cons 40 (cadr n))
 '(210 0. 0. 1.)
 )
 )
 )
 (setq es (cons e es))
 )
 (setq eser (cons n eser))
 )
)
(list es eser)
 )
 (setq untp (type un))
 (cond ((= untp 'ename) (setq l (list un)))
((= untp 'list) (setq l un))
((= untp 'pickset)
 (repeat (setq len (sslength un))
 (setq l (cons (ssname un (setq len (1- len))) l))
 )
)
 )
 (foreach n l
(setq ent (entget n))
(setq untp (cdr (assoc 0 ent)))
(cond ((= untp "LINE")
 (setq pt1 (cdr (assoc 10 ent)))
 (setq pt2 (cdr (assoc 11 ent)))
 (if (> (distance pt1 pt2) fuzz)
 (setq dseb (cons (list pt1 pt2 0.0) dseb))
 (setq esz (cons n esz))
 )
 )
 ((= untp "ARC")
 (setq cen (cdr (assoc 10 ent)))
 (setq rad (cdr (assoc 40 ent)))
 (setq an1 (cdr (assoc 50 ent)))
 (setq an2 (cdr (assoc 51 ent)))
 (setq pt1 (polar cen an1 rad))
 (setq pt2 (polar cen an2 rad))
 (setq an1 (- an2 an1))
 (and (minusp an1) (setq an1 (+ an1 6.283185307179586)))
 (if (> (distance pt1 pt2) fuzz)
 (if (zerop (setq an2 (cos (setq an1 (/ an1 4.0)))))
 (setq dseb (cons (list pt1 pt2 1.7e308) dseb))
 (setq dseb (cons (list pt1 pt2 (/ (sin an1) an2)) dseb))
 )
 (if (and (> rad fuzz) (> an1 3.141592653589793))
 (setq dcr (cons (list cen rad) dcr))
 (setq esz (cons n esz))
 )
 )
 )
 ((= untp "CIRCLE")
 (setq cen (cdr (assoc 10 ent)))
 (setq rad (cdr (assoc 40 ent)))
 (if (> rad fuzz)
 (setq dcr (cons (list cen rad) dcr))
 (setq esz (cons n esz))
 )
 )
 (t (setq eser (cons n eser)))
)
 )
 (foreach n (append eser esz) (setq l (vl-remove n l)))
;(princ (list dseb dcr l eser esz));debug
;(list dseb dcr l eser esz);1.(起点终点凸度)2.(圆心半径)3.(在容差内的图元)4.(不在容差内的图元)5.(相对fuzz零长度图元)
 (setq nsebs (xx dseb fuzz))
 (setq pls (yy nsebs fuzz)) ;(list plcs plos pler);1.(闭合多段线)2.(不闭合多段线)3.(不能生成的多段线数据)
 (setq crs (zz dcr)) ;(list es eser);1.(圆)2.(不能生成的圆数据)
 (and
isd
(foreach n l
 (entdel n) ;删除原数据

)
 )
 (foreach n esz
(entdel n) ;删除相对零长度实体

 )
 (setq newc (append
 (car pls)
 (car crs)
 )
 )
 (setq newo (cadr pls))
 (list newc newo (caddr pls) (cadr crs) eser)
;1.(新闭合的实体)2.(未闭合的实体)3.(不能生成的多段线数据)4.(不能生成的圆数据)5.不能识别的实体

)
(vl-load-com)

;聚合测试
(defun c:lj (/ fuzz isd n rt ss)
 (setq ss (ssget)) ;只处理线段,圆弧,圆
 (setq isd t) ;是否删除原数据
 (setq fuzz 0.000001) ;相隔多远认为是相连的,曲线的长度或圆的半径小于此值将被当成0长度实体且被删除.
 (nortime)
 (setq rt (|xxyyzz ss isd fuzz))
 (princ "\n*****共聚合实体*****\n")
 (print (sslength ss))
 (princ "\n*****新生成的闭合实体*****\n")
 (print (length (car rt)))
 (princ "\n*****新生成的打开实体*****\n")
 (print (length (cadr rt)))
;??(foreach n (cadr rt)
;? ? (redraw n 3)
;??)
 (princ "\n*****不能生成的多段线*****\n")
 (print (length (caddr rt)))
 (princ "\n*****不能生成的圆*****\n")
 (print (length (cadddr rt)))
 (princ "\n*****未处理的实体(不是线段,圆弧或圆)*****\n")
 (print (length (last rt)))
 (princ "\n**********\n")
 (gettime)
 (setq ss nil)
 (princ)
)

(defun nortime nil
 (setvar "userr1" (getvar "tdusrtimer"))
 (princ)
)
(defun gettime nil
 (princ
(strcat "\n用时:"
 (rtos (* (- (getvar "tdusrtimer") (getvar "userr1")) 86400)
 2
 3
 )
 "秒.\n"
)
 )
 (princ)
)

前生 · 发表于 2017-6-28 13:47:40

有点长。

pezyl · 发表于 2017-6-28 14:09:07

支持顶一个，谢谢

前生 · 发表于 2017-6-28 23:42:54

以前别的同志写的一个。一直在用。
(defun c:LJ (/ ss1 ss indi i j sname en1 en2 en3 en4)
 (SETQ SS1 NIL
I NIL
J NIL
SS NIL
inde nil
en3 nil
en4 nil
en1 nil
en2 nil
sname nil
 )
 (prompt "请选择要编辑成多义线的物体")

 (prompt "请选择要编辑成多义线的物体")
 (SETQ SS1 (SSGET))
 (if ss1
(setq i 0
 j (sslength ss1)
 ss (ssadd)
)
(setq i 0
 j 0
)
 )
 (while (< i j)
(setq indi (ssname ss1 i))
(setq en3 (cdr (assoc 8 (entget indi))))
(setq en4 (cdr (assoc 70 (tblsearch "layer" en3))))
(if (/= en4 4)
 (setq ss (ssadd indi ss))
)
(setq i (1+ i))
 )
 (if (/= ss nil)
(progn
 (setq nn (sslength ss))
 (setq i 0)
 (repeat (- nn 1)
(setq sname (ssname ss i))
(setq en1 (entget sname))
(setq en2 (cdr (assoc 0 (entget sname))))
(if (and (/= en1 nil)
 (or (= en2 "LINE")
 (= en2 "ARC")
 (and (= en2 "LWPOLYLINE")
 (= (cdr (assoc 70 (entget sname))) 0)
 )
 )
 )
 (progn
 (setq en (cdr (assoc 0 (entget sname))))
 (if (or (= en "LWPOLYLINE") (= en "POLYLINE"))
 (command "pedit" sname "j" ss "" "")
 (command "pedit" sname "y" "j" ss "" "")
 )
 (setq i (+ i 1))
 )
 (setq i (+ i 1))
)
 )
)
 )
 (setq ss nil)

 (princ)
)

xoyo88 · 发表于 2019-5-7 10:09:56

支持一下,支持一下,支持一下

9635luyu · 发表于 2023-3-26 23:52:06

支持一下吧

ilovem · 发表于 2023-5-6 11:02:44

谢谢楼主的分享

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

[研讨] 连接成多段线

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

评分

点评

评分

点评

评分