[编程申请]：把选定的LINE连接成PLINE

saintdog · 发表于 2002-9-13 15:12:56

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

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

×

以前在论坛上看到过把LINE连接成PLINE的程序。很可惜没有录下来。哪位朋友能给我一个这样的程序么？

saintdog · 发表于 2002-9-13 15:18:45

ACAD2002中提供的PLJOIN程序有一个缺点:将LINE连成多义线（PLINE）后，如果需要修改，用EXPLODE炸掉，就会在LINE的节点处留下许多小点。

XDSoft · 发表于 2002-9-13 18:26:35

最初由 saintdog 发布
[B]ACAD2002中提供的PLJOIN程序有一个缺点:将LINE连成多义线（PLINE）后，如果需要修改，用EXPLODE炸掉，就会在LINE的节点处留下许多小点。 [/B]

晓东工具箱里面的obj_curve.lsp里面有“连接线段”的代码，去参考参考。

zemehua · 发表于 2002-10-14 17:21:57

装载EXPRESS，在EXPRESS下，MOdify>Multiple Mpedit>join就可以办到！

活塞 · 发表于 2002-10-15 19:38:40

不知你是什么地方用的？试试下面这个吧。

活塞 · 发表于 2002-10-15 19:43:08

[FONT=courier new]
;;判断对象的名称及规格
(defun etype (ent / ename)
(setq ename (cdr (assoc 0 (entget ent))))
(cond
((= "POLYLINE" ename)
(if (> (cdr (assoc 70 (entget ent))) 7)
8
(if (= 0 (logand 1 (cdr (assoc 70 (entget ent)))))
1
5
)
)
)
((= "LWPOLYLINE" ename)
(if (= 0 (logand 1 (cdr (assoc 70 (entget ent)))))
2
5
)
)
((= "LINE" ename) 3)
((= "ARC" ename) 4)
((= "CIRCLE" ename) 6)
((= "INSERT" ename) 7)
(T 9)
)
)
;; 判断对象是否为顶点(用于多义线)
;;
(defun isvertex (ent)
;; 'en' is entity name
(if (= "VERTEX" (cdr (assoc 0 (entget ent))))
(cdr (assoc 70 (entget ent)))
)
)
;; 找出对象距离选择点的最近一个端点
(defun nearvtx (ent etp p / p1 p2 l r f)
(cond
((= 1 etp)
(setq ent (entnext ent))
(setq p1 (cdr (assoc 10 (entget ent))))
(setq ent (entnext ent))
(while (/= nil (setq f (isvertex ent)))
(setq l ent
ent (entnext ent)
)
)
(setq p2 (cdr (assoc 10 (entget l))))
(if (> (distance p1 p) (distance p2 p))
p2
p1
)
)
((= 2 etp)
(setq p1 (cdr (assoc 10 (entget ent))))
(setq p2 (cdr (assoc 10 (reverse (entget ent)))))
(if (> (distance p1 p) (distance p2 p))
p2
p1
)
)
((= 3 etp)
(progn
(setq ent (entget ent))
(setq p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
)
(if (> (distance p1 p) (distance p2 p))
p2
p1
)
)
)
(T
(progn
(setq ent (entget ent))
(setq l (cdr (assoc 10 ent))
r (cdr (assoc 40 ent))
)
(setq p1 (polar l (cdr (assoc 50 ent)) r))
(setq p2 (polar l (cdr (assoc 51 ent)) r))
(if (> (distance p1 p) (distance p2 p))
p2
p1
)
)
)
)
)
;;
;; 主程序，对线进行连接
;;
(defun C:JL
(/ oldecho oldsnap oldortho en l e r s n g c d p i tt p1 p2)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq oldortho (getvar "orthomode"))
(setvar "orthomode" 0)
(if (setq en (entsel "\n请选择进行连接的线:"))
(progn
(while (< 4 (setq l (etype (car en))))
(cond
((= 5 l)
(princ "\n不能选择闭合的线")
)
((= 8 l)
(princ "\n不能选择三维多义线")
)
(T
(princ "\n所选对象不是线")
)
)
(while (not (setq en (entsel "\n请重新选择进行连接的线:")))
(princ "\n未选择对象")
)
)
(while (not (setq e (entsel "\n请选择连接到的线:")))
(princ "\n未选择对象")
)
(while (< 4 (setq r (etype (car e))))
(cond
((= 5 l)
(princ "\n不能选择闭合的线")
)
((= 8 l)
(princ "\n不能选择三维多义线")
)
(T
(princ "\n所选对象不是线")
)
)
(while (not (setq e (entsel "\n请重新选择连接到的线:")))
(princ "\n未选择对象")
)
)
(setq s (entget (car en)))
(setq n (cdr (assoc 10 s)))
(setq g (caddr n))
(setq c (entget (car e)))
(setq d (cdr (assoc 10 c)))
(setq p (caddr d))
(setq i (list 0 0 g))
(setq tt (list 0 0 p))
(command "move" (car e) "" tt i)
(setq p1 (nearvtx (car en) l (cadr en)))
(setq p2 (nearvtx (car e) r (cadr e)))
(if (> l 2)
(progn
(command "PEDIT" (car en) "Y" "X")
(setq en (entlast))
)
)
(if (not (equal p1 p2))
(command "PLINE" p1 p2 "")
)
(command "pedit" en "j" en "L" (car e) "" "")
)
(princ "\n未选择对象，退出。")
)
(setvar "cmdecho" oldecho)
(setvar "osmode" oldsnap)
(setvar "orthomode" oldortho)
(princ)
)[/FONT]

[FONT=courier new] 
;;判断对象的名称及规格 
(defun etype (ent / ename) 
  (setq ename (cdr (assoc 0 (entget ent)))) 
  (cond 
    ((= "POLYLINE" ename) 
     (if (> (cdr (assoc 70 (entget ent))) 7) 
       8 
       (if (= 0 (logand 1 (cdr (assoc 70 (entget ent))))) 
         1 
         5 
       ) 
     ) 
    ) 
    ((= "LWPOLYLINE" ename) 
     (if (= 0 (logand 1 (cdr (assoc 70 (entget ent))))) 
       2 
       5 
     ) 
    ) 
    ((= "LINE"   ename) 3) 
    ((= "ARC"    ename) 4) 
    ((= "CIRCLE" ename) 6) 
    ((= "INSERT" ename) 7) 
    (T                  9) 
  ) 
) 
 
;; 判断对象是否为顶点(用于多义线) 
;; 
(defun isvertex        (ent) 
  ;; 'en' is entity name 
  (if (= "VERTEX" (cdr (assoc 0 (entget ent)))) 
    (cdr (assoc 70 (entget ent))) 
  ) 
) 
 
;; 找出对象距离选择点的最近一个端点 
(defun nearvtx (ent etp p / p1 p2 l r f) 
  (cond 
    ((= 1 etp) 
     (setq ent (entnext ent)) 
     (setq p1 (cdr (assoc 10 (entget ent)))) 
     (setq ent (entnext ent)) 
     (while (/= nil (setq f (isvertex ent))) 
       (setq l         ent 
             ent (entnext ent) 
       ) 
     ) 
     (setq p2 (cdr (assoc 10 (entget l)))) 
     (if (> (distance p1 p) (distance p2 p)) 
       p2 
       p1 
     ) 
    ) 
    ((= 2 etp) 
     (setq p1 (cdr (assoc 10 (entget ent)))) 
     (setq p2 (cdr (assoc 10 (reverse (entget ent))))) 
     (if (> (distance p1 p) (distance p2 p)) 
       p2 
       p1 
     ) 
    ) 
    ((= 3 etp) 
     (progn 
       (setq ent (entget ent)) 
       (setq p1        (cdr (assoc 10 ent)) 
             p2        (cdr (assoc 11 ent)) 
       ) 
       (if (> (distance p1 p) (distance p2 p)) 
         p2 
         p1 
       ) 
     ) 
    ) 
    (T 
     (progn 
       (setq ent (entget ent)) 
       (setq l (cdr (assoc 10 ent)) 
             r (cdr (assoc 40 ent)) 
       ) 
       (setq p1 (polar l (cdr (assoc 50 ent)) r)) 
       (setq p2 (polar l (cdr (assoc 51 ent)) r)) 
       (if (> (distance p1 p) (distance p2 p)) 
         p2 
         p1 
       ) 
     ) 
    ) 
  ) 
) 
;; 
;;  主程序，对线进行连接 
;; 
(defun C:JL 
       (/ oldecho oldsnap oldortho en l e r s n g c d p i tt p1 p2) 
  (setq oldecho (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (setq oldsnap (getvar "osmode")) 
  (setvar "osmode" 0) 
  (setq oldortho (getvar "orthomode")) 
  (setvar "orthomode" 0) 
  (if (setq en (entsel "\n请选择进行连接的线:")) 
    (progn 
      (while (< 4 (setq l (etype (car en)))) 
        (cond 
          ((= 5 l) 
           (princ "\n不能选择闭合的线") 
          ) 
          ((= 8 l) 
           (princ "\n不能选择三维多义线") 
          ) 
          (T 
           (princ "\n所选对象不是线") 
          ) 
        ) 
        (while (not (setq en (entsel "\n请重新选择进行连接的线:"))) 
          (princ "\n未选择对象") 
        ) 
      ) 
 
      (while (not (setq e (entsel "\n请选择连接到的线:"))) 
        (princ "\n未选择对象") 
      ) 
      (while (< 4 (setq r (etype (car e)))) 
        (cond 
          ((= 5 l) 
           (princ "\n不能选择闭合的线") 
          ) 
          ((= 8 l) 
           (princ "\n不能选择三维多义线") 
          ) 
          (T 
           (princ "\n所选对象不是线") 
          ) 
        ) 
        (while (not (setq e (entsel "\n请重新选择连接到的线:"))) 
          (princ "\n未选择对象") 
        ) 
      ) 
      (setq s (entget (car en))) 
      (setq n (cdr (assoc 10 s))) 
      (setq g (caddr n)) 
      (setq c (entget (car e))) 
      (setq d (cdr (assoc 10 c))) 
      (setq p (caddr d)) 
      (setq i (list 0 0 g)) 
      (setq tt (list 0 0 p)) 
      (command "move" (car e) "" tt i) 
 
      (setq p1 (nearvtx (car en) l (cadr en))) 
 
      (setq p2 (nearvtx (car e) r (cadr e))) 
 
      (if (> l 2) 
        (progn 
          (command "PEDIT" (car en) "Y" "X") 
          (setq en (entlast)) 
        ) 
      ) 
      (if (not (equal p1 p2)) 
        (command "PLINE" p1 p2 "") 
      ) 
      (command "pedit" en "j" en "L" (car e) "" "") 
    ) 
    (princ "\n未选择对象，退出。") 
  ) 
  (setvar "cmdecho" oldecho) 
  (setvar "osmode" oldsnap) 
  (setvar "orthomode" oldortho) 
  (princ) 
)[/FONT]

cuiwenjun2008 · 发表于 2004-11-27 02:50:50

下载了JL.lisp，很感谢。可以解燃眉之急。不足的就是，是不是应该把选中的线变虚，这样就知道自己选哪根线了，省得弄混了！
另外，就是无法多项选，就是无法倒框，每次只能处理两条线。请5楼主修改，好吗?

zengwei104 · 发表于 2004-12-20 09:05:42

不错，给我解决了一个大问题

wangxj2002 · 发表于 2004-12-27 19:57:37

非常感谢分享！！

ivysoft · 发表于 2005-1-7 12:56:43

我开发的小工具（常青藤）可以帮助你实现。
修改菜单下的直线合并多线就是此功能，且虚线显示，支持框选，新实体属性随选择的第一个实体。
具体请参考：http://www.xdcad.net/forum/showthread.php?s=&threadid=322975

sieben · 发表于 2005-1-8 23:28:56

c:j 把所有选上的Line 和Arc连成Lwpolyline
c:j 把所有能和选上的Line 和Arc连成Lwpolyline的实体连成Lwpolyline

sieben · 发表于 2005-1-8 23:30:58

不好意思,前面的第二个C:J应为C:JJ

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

[编程申请]：把选定的LINE连接成PLINE

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

相关帖子

ACAD2002中提供的PLJOIN程序有一个缺点

Re: ACAD2002中提供的PLJOIN程序有一个缺点

浏览过的版块