求助：根据z值连接多段线的代码

杜阳

我写了一个简单的根据z值连接多段线的代码，思路：先根据选择的两条线的z值判断来确定是否连接，如果z值相同就实现连接并拟合连接后的线，如果z值不等，就重新选择，可是代码实现的是：z值相等连接并拟合成同一条线，z值不等时，两条线只连接，不拟合，也不是一条线 是三段不同的线。望各位老师给予帮助。
这段代码还有一个缺点就是，能不能根据两条线的相邻顶点进行连接，如果多段线的起始方向不合理，连接就不合理了。
学生在此感谢各位老师给予指导，谢谢。
一下是代码：
(Defun C:cjlj (/ Ss1 ss2 Pt1 Pt2 p1 p2)
(vl-load-com)
  (Setvar "Cmdecho" 0)
    (Setq Pt1 (Getvar "Vsmin"))
    (Setq Pt2 (Getvar "Vsmax"))
    (Setq Ss1 (Entsel "\n 选择1线:"))
    (Setq Ss2 (Entsel "\n 选择2线:"))
    (Setq p1 (vlax-curve-getendpoint (car ss1)))
    (Setq p2 (vlax-curve-getstartpoint (car ss2)))
    (setq Z1(car(assoc 38 (entget (car ss1)))))
    (setq Z2(car(assoc 38 (entget (car ss2)))))
(if (= z1 z2)
(progn
(Vl-Cmdf "line" p1 p2 "")
(Vl-Cmdf ".Pedit" Ss1 "Yes" "J" "C" Pt1 Pt2 "" "" )
(Vl-Cmdf ".Pedit" Ss1 "Yes" "s" Pt1 Pt2 "" "")
)
)
(Setvar "Cmdecho" 1)
(Princ)
)

自贡黄明儒

写好这个代码不容易，我至今还是用overkill

杜阳

自贡黄明儒 发表于 2014-9-12 13:48
写好这个代码不容易，我至今还是用overkill

黄老师  能不能  你给看看代码 条件判断是不是不对啊

自贡黄明儒

杜阳 发表于 2014-9-12 14:00
黄老师  能不能  你给看看代码 条件判断是不是不对啊

;;164.29 [功能] 连接线、弧成多段线
;;(HH:JionToPolyline)
(defun HH:JionToPolyline (/ PET SS)
  (setq pet (getvar "PEDITACCEPT"))
  (setvar "PEDITACCEPT" 1)
  (while (setq ss (ssget '((0 . "ARC,*LINE"))))
    (command "_.pedit" (ssname ss 0) "j" ss "" "")
  )
  (setvar "PEDITACCEPT" pet)
  (princ)
)

;;假如我要写的话，可能会这样
(Defun C:cjlj (/ PET SS1 SS2 Z1)
  (vl-load-com)
  (setq pet (getvar "PEDITACCEPT"))
  (setvar "PEDITACCEPT" 1)
  (Setq Ss1 (Entsel "\n 选择1线:"))
  (setq Z1 (car (assoc 38 (entget (car ss1)))))
  (Setq Ss2 (ssget (list '(0 . "ARC,*LINE") (cons 38 Z1))))
  (command "_.pedit" (ssname ss2 0) "j" ss2 "" "")
  (setvar "PEDITACCEPT" pet)
  (princ)
)

杜阳

自贡黄明儒 发表于 2014-9-12 14:17
;;164.29 [功能] 连接线、弧成多段线
;;(HH:JionToPolyline)
(defun HH:JionToPolyline (/ PET SS)

谢谢黄老师百忙之中给予解答，可是我实验 光有选线  其他的就不执行了

gzxl

这个单靠Z值相等来判断，我觉得不合理，如果两条线相隔较远，那是不是会出错？
这里提供以前找到的，现在不知道是那个高手编的，仅供参考

2. ;;智能连接线
   
3. (defun c:BJ_CurveJoin ( / ss pda en fuzz val)
   
4.   (vl-load-com)
   
5.   (setq val (getvar "cmdecho"))
   
6.   (setvar "cmdecho" 0)
   
7.   (princ (strcat "\n请选择线"))
   
8.   (if (and (setq en (car (entsel "\n选择第一条线:")))
   
9.            (wcmatch (cdr (assoc 0 (entget en))) "ARC,LINE,*POLYLINE")
   
10.            (setq en (vlax-ename->vla-object en))
    
11.            (/= "AcDb3dPolyline" (vla-get-ObjectName en))
    
12.       )
    
13.       (progn
    
14.          (if (null (setq fuzz (getdist "\n输入模糊距离<0>: ")))
    
15.              (setq fuzz 0)
    
16.          )
    
17.          (setq ss (ssadd)) ;创建新的选择集
    
18.          (foreach item
    
19.             (setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))
    
20.             (ssadd (vlax-vla-object->ename item) ss)
    
21.          )
    
22.          (mip:mark)
    
23.          (vl-catch-all-apply
    
24.              '(lambda ()
    
25.                 (if (setq pda (getvar "PEDITACCEPT"))
    
26.                     (progn
    
27.                        (setq pda (getvar "peditaccept"))
    
28.                        (setvar "peditaccept" 1)
    
29.                        (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")
    
30.                        (setvar "peditaccept" pda)
    
31.                     )
    
32.                     (command "_pedit" "_M" ss "" "_Y" "_j" "_j" "_b" fuzz "")
    
33.                 )
    
34.               )
    
35.          )
    
36.          (setq lst (vl-remove-if 'vlax-erased-p lst))
    
37.          (if (setq ss nil ss (mip:get-last-ss))
    
38.              (progn
    
39.                 (if lst (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))
    
40.                 (setq fuzz 0)
    
41.                 (while (setq en (ssname ss fuzz))
    
42.                     (if (/= (cdr (assoc 0 (entget en))) "LWPOLYLINE")
    
43.                         (ssdel en ss)
    
44.                         (setq fuzz (1+ fuzz))
    
45.                     )
    
46.                 )
    
47.                 (sssetfirst ss ss)
    
48.              )
    
49.          )
    
50.          (setq ss nil)
    
51.       )
    
52.       (princ "\n需选择LINE, ARC or Polyline")
    
53.   )
    
54.   (setvar "cmdecho" val)
    
55.   (princ)
    
56. )
    
57. (defun ChainSelectFromAny (pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl)
    
58.   (vl-load-com)
    
59.   (cond
    
60.     ((= (type pt) 'ENAME)
    
61.         (setq ln (vlax-ename->vla-object pt)
    
62.               pt nil
    
63.         )
    
64.     )
    
65.     ((= (type pt) 'VLA-OBJECT)
    
66.       (setq ln pt pt nil)
    
67.     )
    
68.     (t nil)
    
69.   )
    
70.   (if (setq ss (ssget "_I") ss nil ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))
    
71.       (progn
    
72.          (if pt
    
73.            (progn
    
74.               (setq ln1
    
75.                  (vla-addLine
    
76.                      (if (and (zerop (vla-get-ActiveSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
    
77.                               (= :vlax-false (vla-get-MSpace (vla-get-ActiveDocument (vlax-get-acad-object))))
    
78.                          )
    
79.                          (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
    
80.                          (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
    
81.                      )
    
82.                      (vlax-3D-point pt)
    
83.                      (vlax-3D-point (mapcar '- pt '(1 1 0)))
    
84.                  )
    
85.               )
    
86.               (setq ln ln1)
    
87.            )
    
88.          )
    
89.          (setq spt (vlax-curve-getStartPoint ln)
    
90.                ept (vlax-curve-getEndPoint ln)
    
91.          )
    
92.          (setq line_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
    
93.                chain_list nil
    
94.                chain_list (cons ln chain_list)
    
95.          )
    
96.          (setq line_list (vl-remove-if '(lambda (x) (eq "AcDb3dPolyline" (vla-get-ObjectName x))) line_list))
    
97.          (setq loop t cycl 0)
    
98.          (while loop
    
99.            (while
    
100.               (setq couple
     
101.                  (vl-remove-if-not
     
102.                     (function (lambda (x)
     
103.                                 (or (equal (vlax-curve-getStartPoint x) (vlax-curve-getStartPoint ln) fuzz)
     
104.                                     (equal (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint ln) fuzz)
     
105.                                     (equal (vlax-curve-getEndPoint x) (vlax-curve-getStartPoint ln) fuzz)
     
106.                                     (equal (vlax-curve-getEndPoint x) (vlax-curve-getEndPoint ln) fuzz)
     
107.                                 )
     
108.                               )
     
109.                     )
     
110.                     line_list
     
111.                  )
     
112.               )
     
113.               (grtext -1 (strcat "正在连线，请稍等 - " (itoa (setq cycl (1+ cycl)))))
     
114.               (if couple
     
115.                  (progn
     
116.                     (setq chain_list (append couple chain_list))
     
117.                     (setq line_list (vl-remove ln line_list))
     
118.                     (setq ln (car chain_list))
     
119.                  )
     
120.                  (setq line_list (cdr line_list))
     
121.               )
     
122.            )
     
123.            (setq loop nil)
     
124.          )
     
125.       )
     
126.   )
     
127.   (setq chain_list (vl-remove ln1 chain_list))
     
128.   (if (= (type ln1) 'VLA-OBJECT)
     
129.       (vl-catch-all-apply 'vla-erase (list ln1))
     
130.   )
     
131.   (vl-cmdf "_.redraw")
     
132.   chain_list
     
133. )
     
134. (defun mip:mark (/ val)
     
135.   (setq val (getvar "cmdecho")) (setvar "cmdecho" 0)
     
136.   (if (setq *mip:mark (entlast)) nil
     
137.       (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))
     
138.              (setq *mip:mark (entlast))
     
139.              (entdel *mip:mark)
     
140.       )
     
141.   )
     
142.   (setvar "cmdecho" val)
     
143.   (princ)
     
144. )
     
145. (defun mip:get-last-ss (/ ss tmp val)
     
146.   (setq val (getvar "cmdecho"))
     
147.   (setvar "cmdecho" 0)
     
148.   (if *mip:mark
     
149.      (progn
     
150.         (setq ss (ssadd))
     
151.         (while
     
152.            (setq *mip:mark (entnext *mip:mark))
     
153.            (ssadd *mip:mark ss)
     
154.         )
     
155.         (command "._select" ss "")
     
156.         (setq tmp ss ss nil)
     
157.      )
     
158.      (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")
     
159.   )
     
160.   (setvar "cmdecho" val)
     
161.   tmp
     
162. )

;;智能连接线<br /> (defun c:BJ_CurveJoin ( / ss pda en fuzz val)<br />   (vl-load-com)<br />   (setq val (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (princ (strcat "\n请选择线"))<br />   (if (and (setq en (car (entsel "\n选择第一条线:")))<br />            (wcmatch (cdr (assoc 0 (entget en))) "ARC,LINE,*POLYLINE")<br />            (setq en (vlax-ename->vla-object en))<br />            (/= "AcDb3dPolyline" (vla-get-ObjectName en))<br />       )<br />       (progn <br />          (if (null (setq fuzz (getdist "\n输入模糊距离<0>: ")))<br />              (setq fuzz 0)<br />          )<br />          (setq ss (ssadd)) ;创建新的选择集<br />          (foreach item<br />             (setq lst (ChainSelectFromAny en (+ fuzz 1e-6)))<br />             (ssadd (vlax-vla-object->ename item) ss)<br />          )<br />          (mip:mark)<br />          (vl-catch-all-apply<br />              '(lambda ()<br />                 (if (setq pda (getvar "PEDITACCEPT"))<br />                     (progn <br />                        (setq pda (getvar "peditaccept"))<br />                        (setvar "peditaccept" 1)<br />                        (command "_pedit" "_M" ss "" "_j" "_j" "_b" fuzz "")<br />                        (setvar "peditaccept" pda)<br />                     )<br />                     (command "_pedit" "_M" ss "" "_Y" "_j" "_j" "_b" fuzz "")<br />                 )<br />               )<br />          )<br />          (setq lst (vl-remove-if 'vlax-erased-p lst))<br />          (if (setq ss nil ss (mip:get-last-ss))<br />              (progn<br />                 (if lst (foreach item lst (ssadd (vlax-vla-object->ename item) ss)))<br />                 (setq fuzz 0)<br />                 (while (setq en (ssname ss fuzz))<br />                     (if (/= (cdr (assoc 0 (entget en))) "LWPOLYLINE")<br />                         (ssdel en ss)<br />                         (setq fuzz (1+ fuzz))<br />                     )<br />                 )<br />                 (sssetfirst ss ss)<br />              )<br />          )<br />          (setq ss nil)<br />       )<br />       (princ "\n需选择LINE, ARC or Polyline")<br />   )<br />   (setvar "cmdecho" val)<br />   (princ)<br /> ) <br /> (defun ChainSelectFromAny (pt fuzz / chain_list couple ept line_list ln loop pda spt ss ln1 cycl) <br />   (vl-load-com) <br />   (cond<br />     ((= (type pt) 'ENAME)<br />         (setq ln (vlax-ename->vla-object pt)<br />               pt nil<br />         )<br />     )<br />     ((= (type pt) 'VLA-OBJECT)<br />       (setq ln pt pt nil)<br />     )<br />     (t nil)<br />   )<br />   (if (setq ss (ssget "_I") ss nil ss (ssget "_X" '((0 . "ARC,LINE,*POLYLINE"))))<br />       (progn <br />          (if pt<br />            (progn <br />               (setq ln1<br />                  (vla-addLine<br />                      (if (and (zerop (vla-get-ActiveSpace (vla-get-ActiveDocument (vlax-get-acad-object))))<br />                               (= :vlax-false (vla-get-MSpace (vla-get-ActiveDocument (vlax-get-acad-object))))<br />                          )<br />                          (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))<br />                          (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))<br />                      )<br />                      (vlax-3D-point pt)<br />                      (vlax-3D-point (mapcar '- pt '(1 1 0)))<br />                  )<br />               )<br />               (setq ln ln1)<br />            )<br />          )<br />          (setq spt (vlax-curve-getStartPoint ln)<br />                ept (vlax-curve-getEndPoint ln)<br />          )<br />          (setq line_list (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))<br />                chain_list nil<br />                chain_list (cons ln chain_list)<br />          )<br />          (setq line_list (vl-remove-if '(lambda (x) (eq "AcDb3dPolyline" (vla-get-ObjectName x))) line_list))<br />          (setq loop t cycl 0)<br />          (while loop<br />            (while<br />               (setq couple<br />                  (vl-remove-if-not<br />                     (function (lambda (x)<br />                                 (or (equal (vlax-curve-getStartPoint x) (vlax-curve-getStartPoint ln) fuzz)<br />                                     (equal (vlax-curve-getStartPoint x) (vlax-curve-getEndPoint ln) fuzz)<br />                                     (equal (vlax-curve-getEndPoint x) (vlax-curve-getStartPoint ln) fuzz)<br />                                     (equal (vlax-curve-getEndPoint x) (vlax-curve-getEndPoint ln) fuzz)<br />                                 )<br />                               )<br />                     )<br />                     line_list<br />                  )<br />               )<br />               (grtext -1 (strcat "正在连线，请稍等 - " (itoa (setq cycl (1+ cycl)))))<br />               (if couple<br />                  (progn<br />                     (setq chain_list (append couple chain_list))<br />                     (setq line_list (vl-remove ln line_list))<br />                     (setq ln (car chain_list))<br />                  )<br />                  (setq line_list (cdr line_list))<br />               )<br />            )<br />            (setq loop nil)<br />          )<br />       )<br />   )<br />   (setq chain_list (vl-remove ln1 chain_list))<br />   (if (= (type ln1) 'VLA-OBJECT)<br />       (vl-catch-all-apply 'vla-erase (list ln1))<br />   )<br />   (vl-cmdf "_.redraw")<br />   chain_list<br /> )<br /> (defun mip:mark (/ val)<br />   (setq val (getvar "cmdecho")) (setvar "cmdecho" 0)<br />   (if (setq *mip:mark (entlast)) nil<br />       (progn (entmake '((0 . "point") (10 0.0 0.0 0.0)))<br />              (setq *mip:mark (entlast))<br />              (entdel *mip:mark)<br />       )<br />   )<br />   (setvar "cmdecho" val)<br />   (princ)<br /> )<br /> (defun mip:get-last-ss (/ ss tmp val)<br />   (setq val (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (if *mip:mark<br />      (progn<br />         (setq ss (ssadd))<br />         (while<br />            (setq *mip:mark (entnext *mip:mark))<br />            (ssadd *mip:mark ss)<br />         )<br />         (command "._select" ss "")<br />         (setq tmp ss ss nil)<br />      )<br />      (alert "*mip:mark not set. \n run (mip:mark) before mip:get-last-ss.")<br />   )<br />   (setvar "cmdecho" val)<br />   tmp<br /> )

杜阳

gzxl 发表于 2014-9-13 02:04
这个单靠Z值相等来判断，我觉得不合理，如果两条线相隔较远，那是不是会出错？
这里提供以前找到的，现在不 ...

谢谢 gzxl老师的指导，使用了一下  没有实现任何结果  我再学习一下吧  谢谢老师

xyp1964

杜阳

xyp1964 发表于 2014-9-13 14:14

呵呵  院长  你可来了 呵呵  把你的代码发出来  学习吧   就是你平常用的代码就行  

香田里浪人

gzxl 发表于 2014-9-13 02:04
这个单靠Z值相等来判断，我觉得不合理，如果两条线相隔较远，那是不是会出错？
这里提供以前找到的，现在不 ...

这个确实很实用。