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

杜流浪人 · 发表于 2014-9-12 13:37:29

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

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

×

我写了一个简单的根据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)
)
我是个初学者各位老师见笑了

st788796 · 发表于 2014-9-12 13:48:09

用图说明

杜流浪人 · 发表于 2014-9-12 14:01:25

我不会录制动态图

杜流浪人 · 发表于 2014-9-12 14:06:45

登录/注册后可看大图

如图就是将z值相等的线连接起来，并拟合如果z值不同时请重新选择，如果能通过判断线的z值批量连接最好谢谢老师

st788796 · 发表于 2014-9-12 17:29:10

(defun c:tt (/ ss lst)
(defun Pnts:NearestPts (pts / ptl pl)
(while (> (length pts) 1)
(setq pl
(car (vl-sort
(mapcar '(lambda (x)
(list (distance (car pts) x) (car pts) x)
)
(cdr pts)
)
'(lambda (x1 x2)
(< (car x1) (car x2))
)
)
)
)
(if ptl
(if (< (car pl) (car ptl))
(setq ptl pl)
)
(setq ptl pl)
)
(setq pts (cdr pts))
)
(cdr ptl)
)
(if (setq ss (ssget '((0 . "LWPOLYLINE"))))
(progn
(setq lst (mapcar '(lambda (x)
(list (xdrx_getpropertyvalue x "Elevation")
x
)
)
(xdrx_pickset->ents ss)
)
lst (mapcar 'cdr
(vl-remove-if
'(lambda (a) (/= (length a) 3))
(XD::List:GroupByIndex lst 1e-3)
)
)
)
(mapcar '(lambda (x / ptl)
(setq
ptl (Pnts:NearestPts
(append (mapcar 'xdrx_curve_getstartpoint x)
(mapcar 'xdrx_curve_getendpoint x)
)
)
)
(setq pl (apply 'xdrx_polyline_make ptl))
(xdrx_curve_join (car x) pl)
(xdrx_curve_join (car x) (cadr x))
)
lst
)
)
)
(princ)
)

(defun c:tt (/ ss lst) 
  (defun Pnts:NearestPts (pts / ptl pl) 
    (while (> (length pts) 1) 
      (setq pl 
             (car (vl-sort 
                    (mapcar '(lambda (x) 
                               (list (distance (car pts) x) (car pts) x) 
                             ) 
                            (cdr pts) 
                    ) 
                    '(lambda (x1 x2) 
                       (< (car x1) (car x2)) 
                     ) 
                  ) 
             ) 
      ) 
      (if ptl 
        (if (< (car pl) (car ptl)) 
          (setq ptl pl) 
        ) 
        (setq ptl pl) 
      ) 
      (setq pts (cdr pts)) 
    ) 
    (cdr ptl) 
  ) 
  (if (setq ss (ssget '((0 . "LWPOLYLINE")))) 
    (progn 
      (setq lst        (mapcar        '(lambda (x) 
                           (list (xdrx_getpropertyvalue x "Elevation") 
                                 x 
                           ) 
                         ) 
                        (xdrx_pickset->ents ss) 
                ) 
            lst        (mapcar        'cdr 
                        (vl-remove-if 
                          '(lambda (a) (/= (length a) 3)) 
                          (XD::List:GroupByIndex lst 1e-3) 
                        ) 
                ) 
      ) 
      (mapcar '(lambda (x / ptl) 
                 (setq 
                   ptl (Pnts:NearestPts 
                         (append (mapcar 'xdrx_curve_getstartpoint x) 
                                 (mapcar 'xdrx_curve_getendpoint x) 
                         ) 
                       ) 
                 ) 
                 (setq pl (apply 'xdrx_polyline_make ptl)) 
                 (xdrx_curve_join (car x) pl) 
                 (xdrx_curve_join (car x) (cadr x)) 
               ) 
              lst 
      ) 
    ) 
  ) 
  (princ) 
)

杜流浪人 · 发表于 2014-9-12 22:03:24

st788796 发表于 2014-9-12 17:29

谢谢元老回复可是不是源代码，里面有好多函数没见过谢谢研究一下你的思路谢谢了

lucas3 · 发表于 2014-9-12 22:29:26

杜流浪人发表于 2014-9-12 22:03
谢谢元老回复可是不是源代码，里面有好多函数没见过谢谢研究一下你的思路谢谢了

需要加载晓东API

杜流浪人 · 发表于 2014-9-12 23:04:49

lucas3 发表于 2014-9-12 22:29
需要加载晓东API

谢谢我知道其中有好多函数不知道什么意思呵呵最基本的lisp还没搞懂呢还搞不了xd函数那么高深的

st788796 · 发表于 2014-9-13 09:23:50

1 框选 Pline，
2 构造 (Z值实体) 表，
3 对表按 Z 值分组(XD::List:GroupByIndex)，
4 对分组后的表剔除不是两个Pline的子表
5 遍历构造的表
   构造两个实体的起点、终点点表，四个点
   在点表中找最近点 (Pnts:NearestPts)
   最近的两个点绘制 pline (可以判断是非重合）
   对新生成 pline 和原来两个 pline 进行Join（也可以 Pedit 连接）

杜流浪人 · 发表于 2014-9-13 10:38:12

st788796 发表于 2014-9-13 09:23
1 框选 Pline，
2 构造 (Z值实体) 表，
3 对表按 Z 值分组(XD:ist:GroupByIndex)，

谢谢元老的思路解析谢谢你那个代码有一个自定义函数这个自定义函数没看出来从哪里结束呵呵学生愚钝见谅

杜流浪人 · 发表于 2014-9-13 11:42:06

st788796 发表于 2014-9-13 09:23
1 框选 Pline，
2 构造 (Z值实体) 表，
3 对表按 Z 值分组(XD:ist:GroupByIndex)，

谢谢元老了线连接了没有拟合这一个，我加载了晓东api 功能太强了以后也慢慢学习这个算了呵呵

st788796 · 发表于 2014-9-13 11:58:05

杜流浪人发表于 2014-9-13 11:42
谢谢元老了线连接了没有拟合这一个，我加载了晓东api 功能太强了以后也慢慢学习这个算了呵呵 ...

拟合用pedit f，其它方法还没有查到

杜流浪人 · 发表于 2014-9-13 15:41:58

st788796 发表于 2014-9-13 11:58
拟合用pedit f，其它方法还没有查到

谢谢元老请问如果把两个z值相同的线把他们的点表合并成一个表，再利用点表生成一条线能用到那几个函数谢谢

st788796 · 发表于 2014-9-13 16:09:11

杜流浪人发表于 2014-9-13 15:41
谢谢元老请问如果把两个z值相同的线把他们的点表合并成一个表，再利用点表生成一条线能用到那几 ...

取得顶点表 (xdrx_getproperty e "Vertices")
制造 (apply 'xdrx_polyline_make pts)
注意首尾点连接及去掉重复点

杜流浪人 · 发表于 2014-9-13 17:04:21

st788796 发表于 2014-9-13 16:09
取得顶点表 (xdrx_getproperty e "Vertices")
制造 (apply 'xdrx_polyline_make pts)
注意首尾点连接 ...

非常感谢长老的一直回答与指导感谢老师了 {:soso_e179:}{:soso_e179:}{:soso_e179:}{:soso_e179:}{:soso_e179:}

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

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

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

点评

点评

点评

点评

点评

点评