[求助]：怎样清除多义线（lwpolyline）上的重复点？

petertian · 发表于 2005-9-26 09:02:44

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

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

×

http://www.xdcad.net/forum/showthread.php?s=&threadid=465098

PLgis · 发表于 2005-9-26 10:28:13

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

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

×

我的做法是：
得到多义线的所有节点，去掉重复点后，重画。

petertian · 发表于 2005-9-26 14:57:22

[QUOTE]最初由 PLgis 发布
[B]我的做法是：
得到多义线的所有节点，去掉重复点后，重画。 [/B][/QUOTE

你的方法对于我不适用，我现在已经从图形中提出了顶点总数和顶点坐标，顶点总数是187个，但是顶点坐标提出来是186个。我发现有两个顶点坐标是一样的，但是，提取顶点坐标时，把重复的点只提取了一个坐标。我现在要计算去掉重复点后点的总数和坐标！

PLgis · 发表于 2005-9-27 10:34:07

petertian: 我不知道你是如何提取的顶点坐标。如果不做特殊处理，应该会把所有顶点（包括坐标重复的顶点）的坐标都提取出来的，正因为如此，我们才知道有重复的顶点。
如果“提取顶点坐标时，把重复的点只提取了一个坐标。”，不正好达到了“我现在要计算去掉重复点后点的总数和坐标！”的目的了吗？

xyp1964 · 发表于 2005-9-27 13:13:07

最初由 petertian 发布
[B][QUOTE]最初由 PLgis 发布
[B]我的做法是：
得到多义线的所有节点，去掉重复点后，重画。 [/B][/QUOTE

你的方法对于我不适用，我现在已经从图形中提出了顶点总数和顶点坐标，顶点总数是187个，但是顶点?.. [/B]

可以参考下面这个程序：

[FONT=courier new];;;加载通用函数
;;;下载：[url]http://www.xdcad.net/forum/showthread.php?s=&threadid=325268[/url]
(load "xyp_lib")
;|
;;;功能 : 多义线顶点序号及坐标标注，可输出坐标数据到文本文件。
适用于 POLYLINE 及 LWPOLYLINE 图元 <lmf97231>
多义线编号--起始点随意选
在对管线（多义线）用LISP程序进行自动编号和座标计算时，有时需要编号顺时针递增，
有时又需要编号逆时针递增，在选取多义线时，通过选取点来确定编号方向，也就是说当
选取左半部分时从左往右开始，选取右半部分时从右往左开始。
2005.02.26 根据<xxming>的要求，修改标注闭合多义线存在的问题
2005.04.29 增加输出坐标数据到文本文件功能
|;
(defun c:test065 ()
(CMDLA0)
(setbl)
(jzhz)
(setq tx1 (UKWORD 1 "1 2" "\n确定顶点顺序 : 1-正向/2-反向" tx1)
tx2 (UKWORD 1 "Y N" "\n是否输出顶点坐标数据：Y-是/N-否" tx2)
)
(if (= tx2 "Y")
(setq ffn (getfiled "\n保存的坐标文件" "坐标" "txt" 1)
ff (open ffn "w")
)
)
(while (setq s1 (entsel "\n选择对象<退出> : "))
(setq en (car s1))
(if (or (= (DXF 0 (entget en)) "POLYLINE")
(= (DXF 0 (entget en)) "LWPOLYLINE")
)
(progn
(setq eobj (vlax-ename->vla-object en)
i -1
)
(if (= tx1 "1") ;正向
(progn
(while
(setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
(princ)
)
(if (or (= (DXF 70 (entget en)) 1)
(equal (vlax-curve-getEndPoint en)
(vlax-curve-getstartPoint en)
)
)
(setq n (- i 1))
(setq n i)
)
(setq i -1)
(repeat n
(setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
(MKLA "坐标编号" 1)
(command "text"
"j"
"mr"
(polar pt0 (* pi 0.75) (* sc 200))
(* sc 400)
"0"
(rtos (+ 1 i) 2 0)
)
(MKLA "坐标" 3)
(X_zb pt0)
(if (= tx2 "Y")
(wr-tx pt0 ff)
)
)
)
;;反向
(progn
(while
(setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
(princ)
)
(if (or (= (DXF 70 (entget en)) 1)
(equal (vlax-curve-getEndPoint en)
(vlax-curve-getstartPoint en)
)
)
(setq n (- i 1))
(setq n i)
)
(setq i -1)
(repeat n
(setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i))))
(MKLA "坐标编号" 1)
(command "text"
"j"
"mr"
(polar pt0 (* pi 0.75) (* sc 200))
(* sc 400)
"0"
(rtos n 2 0)
)
(setq n (1- n))
(MKLA "坐标" 3)
(X_zb pt0)
(if (= tx2 "Y")
(wr-tx pt0 ff)
)
)
)
)
)
)
)
(if (= tx2 "Y")
(progn
(close ff)
(princ (strcat "\n 坐标写至=>" ffn))
)
)
(CMDLA1)
)
(defun wr-tx (point filename / tx)
(setq tx (strcat (rtos (car point) 2)
" "
(rtos (cadr point) 2)
" "
(rtos (caddr point) 2)
)
)
(write-line tx filename)
)[/FONT]

[FONT=courier new];;;加载通用函数 
;;;下载：[url]http://www.xdcad.net/forum/showthread.php?s=&threadid=325268[/url] 
(load "xyp_lib") 
 
 ;| 
;;;功能 : 多义线顶点序号及坐标标注，可输出坐标数据到文本文件。 
适用于 POLYLINE 及 LWPOLYLINE 图元 <lmf97231> 
多义线编号--起始点随意选 
在对管线（多义线）用LISP程序进行自动编号和座标计算时，有时需要编号顺时针递增， 
有时又需要编号逆时针递增，在选取多义线时，通过选取点来确定编号方向，也就是说当 
选取左半部分时从左往右开始，选取右半部分时从右往左开始。 
2005.02.26 根据<xxming>的要求，修改标注闭合多义线存在的问题 
2005.04.29 增加输出坐标数据到文本文件功能 
|; 
(defun c:test065 () 
  (CMDLA0) 
  (setbl) 
  (jzhz) 
  (setq        tx1 (UKWORD 1 "1 2" "\n确定顶点顺序 : 1-正向/2-反向" tx1) 
        tx2 (UKWORD 1 "Y N" "\n是否输出顶点坐标数据：Y-是/N-否" tx2) 
  ) 
  (if (= tx2 "Y") 
    (setq ffn (getfiled "\n保存的坐标文件" "坐标" "txt" 1) 
          ff  (open ffn "w") 
    ) 
  ) 
  (while (setq s1 (entsel "\n选择对象<退出> : ")) 
    (setq en (car s1)) 
    (if        (or (= (DXF 0 (entget en)) "POLYLINE") 
            (= (DXF 0 (entget en)) "LWPOLYLINE") 
        ) 
      (progn 
        (setq eobj (vlax-ename->vla-object en) 
              i           -1 
        ) 
        (if (= tx1 "1")                        ;正向 
          (progn 
            (while 
              (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))) 
               (princ) 
            ) 
            (if        (or (= (DXF 70 (entget en)) 1) 
                    (equal (vlax-curve-getEndPoint en) 
                           (vlax-curve-getstartPoint en) 
                    ) 
                ) 
              (setq n (- i 1)) 
              (setq n i) 
            ) 
            (setq i -1) 
            (repeat n 
              (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))) 
              (MKLA "坐标编号" 1) 
              (command "text" 
                       "j" 
                       "mr" 
                       (polar pt0 (* pi 0.75) (* sc 200)) 
                       (* sc 400) 
                       "0" 
                       (rtos (+ 1 i) 2 0) 
              ) 
              (MKLA "坐标" 3) 
              (X_zb pt0) 
              (if (= tx2 "Y") 
                (wr-tx pt0 ff) 
              ) 
            ) 
          ) 
          ;;反向 
          (progn 
            (while 
              (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))) 
               (princ) 
            ) 
            (if        (or (= (DXF 70 (entget en)) 1) 
                    (equal (vlax-curve-getEndPoint en) 
                           (vlax-curve-getstartPoint en) 
                    ) 
                ) 
              (setq n (- i 1)) 
              (setq n i) 
            ) 
            (setq i -1) 
            (repeat n 
              (setq pt0 (vlax-curve-getPointAtParam eobj (setq i (1+ i)))) 
              (MKLA "坐标编号" 1) 
              (command "text" 
                       "j" 
                       "mr" 
                       (polar pt0 (* pi 0.75) (* sc 200)) 
                       (* sc 400) 
                       "0" 
                       (rtos n 2 0) 
              ) 
              (setq n (1- n)) 
              (MKLA "坐标" 3) 
              (X_zb pt0) 
              (if (= tx2 "Y") 
                (wr-tx pt0 ff) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (if (= tx2 "Y") 
    (progn 
      (close ff) 
      (princ (strcat "\n 坐标写至=>" ffn)) 
    ) 
  ) 
  (CMDLA1) 
) 
(defun wr-tx (point filename / tx) 
  (setq        tx (strcat (rtos (car point) 2) 
                   " " 
                   (rtos (cadr point) 2) 
                   " " 
                   (rtos (caddr point) 2) 
           ) 
  ) 
  (write-line tx filename) 
)[/FONT]

eachy · 发表于 2005-9-27 18:55:44

http://www.xdcad.net/forum/showt ... 2275798#post2275798

petertian · 发表于 2005-9-27 18:57:16

最初由 xyp1964 发布
[B][QUOTE]最初由 petertian 发布
[B][QUOTE]最初由 PLgis 发布
[B]我的做法是：
得到多义线的所有节点，去掉重复点后，重画。 [/B][/QUOTE

你的方法对于我不适用，我现在已经从图形中提出了顶点总... [/B]

回斑竹，我现在又出现新的问题了，他们需要我的图内lwpolyline不能有重复顶点，我还得删掉lwpolyline上的重复顶点，我用lisp怎么解决？谢谢斑竹！集！

xyp1964 · 发表于 2005-9-27 20:51:59

[FONT=courier new](defun c:test (/ ss i s1)
(setq ss (ssget "X" '((0 . "*POLYLINE") (70 . 0)))
i -1
)
(if ss
(repeat (sslength ss)
(setq s1 (ssname ss (setq i (1+ i))))
(if (equal (vlax-curve-getEndPoint s1)
(vlax-curve-getstartPoint s1)
)
(command "pedit" s1 "c" "")
)
)
)
(princ)
)[/FONT]

WHGF · 发表于 2005-9-28 08:22:26

8楼的代码对LWpolyline也适用吗？

petertian · 发表于 2005-9-28 10:47:52

最初由 xyp1964 发布
[B][CODE](defun c:test (/ ss i s1)
  (setq ss (ssget "X" '((0 . "*POLYLINE") (70 . 0)))
i  -1
  )
  (if ss
(repeat (sslength ss)
   (setq s1 (ssname ss (setq i (1+ i))))
... [/B]

斑竹，您的程序还是不行，运行后不能除掉？

舟自横 · 发表于 2005-9-28 11:14:56

试一下这个:
[PHP]
(defun hy_delcfvetex(en / o1list o1listx pos);;删除重复顶点
 (if (setq o1list (hy_listdoublep (entget en) t))
 (progn (foreach item o1list (if (= (car item) 10)
 (progn (setq pos (vl-position item (entget en)))
 (setq o1listx (hy_addnth item pos (vl-remove item (entget en))))
 )
 )
 )
 (entmod o1listx)
 )
 )
 )

(defun hy_listdoublep(lip do / u item nlist);;判断列表重复项
 (if (/= lip nil)
(progn
(setq nlist nil)
 (setq u 0)
 (repeat (length lip)
(setq item (nth u lip))
(if (< (length(vl-remove item lip))
 (- (length lip) 1)
 )
 (setq nlist (cons item nlist))
 )
(setq u (1+ u))
)
(if do (hy_erasedouble (reverse nlist))
 (reverse nlist))
)
 )
 )
(defun hy_erasedouble(nlist / needlist);;;?删除表重复项保留一项
 (setq needlist nlist)
 (foreach item nlist (setq needlist (append (list item) (vl-remove item needlist)))
)
 (reverse needlist))
(defun hy_addnth(new n oldlist / alist blist);;在指定位置插入项
 (setq alist nil)
 (setq i 0)
 (repeat n
(setq alist (cons (nth i oldlist) alist))
(setq i (1+ i))
)
 (setq alist (reverse alist))
 (setq i n)
 (setq blist nil)
 (repeat (- (length oldlist) n)
(setq blist (cons (nth i oldlist) blist))
(setq i (1+ i))
)
 (setq blist (reverse blist))
 (append alist (list new) blist)
 )
[/PHP]
执行(hy_delcfvetex EN)EN为需要删除顶点的复线

winabcd · 发表于 2005-9-28 11:20:56

提个相关的问题：
如果多义线中有一段较长的直线，被分成许多小段，如何去掉这些中间点让他成为一根长的直线段。

petertian · 发表于 2005-9-28 11:23:11

最初由舟自横发布
[B]试一下这个:
[PHP]
(defun hy_delcfvetex(en / o1list o1listx pos);;删除重复顶点
  (if (setq o1list (hy_listdoublep (entget en) t))
   (progn (foreach item o1list (if (= (car item) 10)
      ... [/B]

舟自横大虾，您好，您的程序还是不行，我的lwpolyline是封闭的，并且压缩后有7兆，想将实验数据传上去还不行（太大），您能否告诉我您的QQ号码或邮箱，我将实验数据发给您！

舟自横大虾，您好,您的程序对于闭合多义线(lwpolyline)不起作用，删除不掉重复顶点！只对不闭合的lwpolyline可以取掉重复顶点！闭合的lwpolyline怎么办？谢谢！

狂刀 · 发表于 2005-9-28 12:52:23

我见过一个。。。。。先占个座位，回头在理会：）

来拉～～～～。在网上掏的，看看效果

多义线瘦身程序： simpl
支持删除重复点，
支持距离阈值（阈值内的顶点合并或取消）
支持角度阈值（阈值内有角度偏差的自动拉直）
对宽度变化的部分跳过不处理（认为是外形不同）
类似闭合的线自动闭合，并消除最后一个顶点。

点击链接看清楚
http://www.xdcad.net/article/upl ... 928185651_simpl.swf

[swf w=600 h=450]http://www.xdcad.net/article/upload/file/194606_20050928185651_simpl.swf[/swf]

舟自横 · 发表于 2005-9-28 14:04:04

最初由 petertian 发布
[B][QUOTE]最初由舟自横发布
[B]试一下这个:
[PHP]
(defun hy_delcfvetex(en / o1list o1listx pos);;删除重复顶点
(if (setq o1list (hy_listdoublep (entget en) t))
(progn (foreach item o1... [/B]

99849930449@sina.com

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

[求助] [求助]：怎样清除多义线（lwpolyline）上的重复点？

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

相关帖子

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

相关帖子