[编程申请]：有没有把短线合成长线的工具

XDSoft

最初由 aeo 发布
[B]是地形图呀
扫描后矢量化的,都这样的
真有好办法就好了 [/B]

大家贴几个局部的图到论坛吧。

znyjszx

可以试一下用多段线重描一遍，尔后将碎线删除。

eachy

最初由 znyjszx 发布
[B]可以试一下用多段线重描一遍，尔后将碎线删除。 [/B]

不要或者很少代码即可：

1 如果是单多义线
xdrx_curve_getpoint 得到起点和终点，用xdrx_line1 连线，entdel多义线，这个可以选择集处理

2 碎线麻烦点，可以先对近似直线的连接，然后按 1 处理
或者用xdrx_entity_box得到最大包围盒，用线上的点连线，然后删除选择集

3 用删除短线命令删除小于一定长度的短线，然后用Pedit的 M 命令，多选，然后用 J 选项输入刚才的长度，也可以做到删除短线并连接的目的。

efan2000

其实它图中的线是单条多段线，只是线条中的各个顶点比较密，而且顶点两两之间的线段长度的角度都不一样，所以只能每隔几个顶点就略去一些顶点，形成与原线条相似的。

god

上面几位高手说得都有道理。果然是高手啊。
现在只能是每隔几个顶点就略去一些顶点了，其实如果编程的话，更合适的处理方法是计算相邻两线段的夹角，小于某个角度的就转换成一条直线，再继续处理下一段。
我在这看到讨论图形加密的，有的人的方法就是把整张图打断成小碎线，绝了。其实转成光栅文件就行了。
我觉得这不是扫描的图形，要不然不会有这么好的效果吧。我做的矢量化图就达不到这种效果。

上面贴出的代码用不了，我在acad2002运行宏，提示没RemoveVertex这个函数。

efan2000

RemoveVertex这个函数是自定义的，就附在上次的代码后面。

god

上面的代码里    For Each EntObj In ThisDrawing.ModelSpace
是遍历ModelSpace，整个图都改了，vba里怎么创建选择集呢？用哪个函数，给个例句好吗？

fjw_ok

最初由 efan2000 发布
[B]其实就是多段线的顶点太密了，下面的例程是用R2000r的VBA作的，大家可以把它转换成其它语言的。目的是把线中每隔几点的之间的顶点去除。
[CODE]
  
Sub Test()
    Dim EntObj As AcadEntity
... [/B]

应该加上判断，比如按顶点间长度控制，这样有实际意义
不然有的点密，有的梳

god

同意楼上的。
这段代码会使两侧的端点消失，最后多义线越来越短，
我认为更合适的处理方法是计算相邻两线段的夹角，小于某个角度的就转换成一条直线，再继续处理下一段。
如果哪位高手能编段程序就好了。

Qlin

用途：精简lwpolyline中多余的顶点

思路：
        方式一：判断相邻顶点的距离，短于给定数值则删除
        方式二：判断相邻线段的夹角，小于给定值则删除中间的顶点

不足：没有对pline中圆弧情况作处理，在圆弧所占比例较大时结果不理想

适合使用范围：
　　矢量化扫描图处理
　　复杂地形等高线简化
　　故意增加节点的图纸

说明：需配合XDRX API使用

2. 
   
3. (defun c:plclean (/ ss key n num ent1)
   
4.   (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
   
5.     (progn
   
6.       (initget "D A")
   
7.       (setq key (getkword "\n选择优化方式[按照距离(D)/按照角度(A)]<D>: "))
   
8.       (if (not key)(setq key "D"))
   
9.       (cond
   
10.         (  (= key "D")
    
11.           (while (not num)
    
12.             (setq num (getdist "\n  输入最小点距: "))
    
13.           );while
    
14.           (setq n 0)
    
15.           (repeat (sslength ss)
    
16.             (setq ent1 (ssname ss n))
    
17.             (pline_checkdist ent1 num)
    
18.             (setq n (1+ n))
    
19.           );repeat
    
20.         )
    
21.         (  (= key "A")
    
22.           (while (not num)
    
23.             (setq num (getangle "\n  输入最小夹角: "))
    
24.           );while
    
25.           (setq n 0)
    
26.           (repeat (sslength ss)
    
27.             (setq ent1 (ssname ss n))
    
28.             (pline_checkang ent1 num)
    
29.             (setq n (1+ n))
    
30.           );repeat
    
31.         )
    
32.       );cond
    
33.       (princ "\n  共清理了")(princ (sslength ss))(princ "条多义线")
    
34.     );progn
    
35.   );if
    
36.   (princ)
    
37. );end
    
38. 
    
39. (defun pline_checkdist (ent_in dist_in / ent_nam pt pt_lst pto ptx n pte)
    
40.   (if ent_in
    
41.     (setq ent_nam (cdr (assoc 0 (entget ent_in))))
    
42.   );if
    
43.   
    
44.   (if (= ent_nam "LWPOLYLINE")(progn
    
45.     (xdrx_SetEntToDb ent_in)
    
46.     (while (setq pt (xdrx_getpolyvtx))
    
47.         (setq pt_lst (cons pt pt_lst))
    
48.     );while
    
49. 
    
50.     (setq n 1)
    
51.     (setq pt_lst (cdr pt_lst)
    
52.           pt_lst (reverse pt_lst)
    
53.           pto (car pt_lst)
    
54.           pt_lst (cdr pt_lst))
    
55.     (foreach ptx pt_lst
    
56.       (if (< (distance ptx pto) dist_in)
    
57.         (progn
    
58.           (xdrx_polyline_removeVertexAt ent_in n)
    
59.           (setq n (1- n))
    
60.         )
    
61.         (setq pto ptx)
    
62.       );if
    
63.       (setq n (1+ n))
    
64.     );foreach
    
65.   ));if
    
66. );end
    
67. 
    
68. (defun pline_checkang (ent_in ang_in / ent_nam pt pt_lst n m angr pat ptb ptc
    
69.                        ang1 ang2 angc)
    
70.   (if ent_in
    
71.     (setq ent_nam (cdr (assoc 0 (entget ent_in))))
    
72.   );if
    
73.   
    
74.   (if (= ent_nam "LWPOLYLINE")(progn
    
75.     (xdrx_SetEntToDb ent_in)
    
76.     (while (setq pt (xdrx_getpolyvtx))
    
77.         (setq pt_lst (cons pt pt_lst))
    
78.     );while
    
79.    
    
80.     (setq pt_lst (reverse pt_lst))
    
81.     (setq n 0 m 1)
    
82.     ;(setq angr (/ (* pi ang_in) 180))
    
83.     (setq angr (- pi ang_in))
    
84.     (setq pta (nth n pt_lst))
    
85.    
    
86.     (setq len1 (- (length pt_lst) 2))
    
87.     (repeat len1
    
88.       (setq ptc (nth (1+ n) pt_lst)
    
89.             ptb (nth (+ n 2) pt_lst)
    
90.             ang1 (angle ptc pta)
    
91.             ang2 (angle ptc ptb)
    
92.             angc (abs(- ang2 ang1)))
    
93. 
    
94.       (if (> angc angr)
    
95.         (progn
    
96.           (xdrx_polyline_removeVertexAt ent_in m)
    
97.         );progn
    
98.         (setq m (1+ m)
    
99.               pta ptc)
    
100.       );if
     
101.       (setq n (1+ n))
     
102.     );repeat
     
103.   ));if
     
104. );end
     

<br /> (defun c:plclean (/ ss key n num ent1)<br />   (if (setq ss (ssget '((0 . "LWPOLYLINE"))))<br />     (progn<br />       (initget "D A")<br />       (setq key (getkword "\n选择优化方式[按照距离(D)/按照角度(A)]<D>: "))<br />       (if (not key)(setq key "D"))<br />       (cond<br />         (  (= key "D")<br />           (while (not num)<br />             (setq num (getdist "\n  输入最小点距: "))<br />           );while<br />           (setq n 0)<br />           (repeat (sslength ss)<br />             (setq ent1 (ssname ss n))<br />             (pline_checkdist ent1 num)<br />             (setq n (1+ n))<br />           );repeat<br />         )<br />         (  (= key "A")<br />           (while (not num)<br />             (setq num (getangle "\n  输入最小夹角: "))<br />           );while<br />           (setq n 0)<br />           (repeat (sslength ss)<br />             (setq ent1 (ssname ss n))<br />             (pline_checkang ent1 num)<br />             (setq n (1+ n))<br />           );repeat<br />         )<br />       );cond<br />       (princ "\n  共清理了")(princ (sslength ss))(princ "条多义线")<br />     );progn<br />   );if<br />   (princ)<br /> );end<br /> <br /> (defun pline_checkdist (ent_in dist_in / ent_nam pt pt_lst pto ptx n pte)<br />   (if ent_in<br />     (setq ent_nam (cdr (assoc 0 (entget ent_in))))<br />   );if<br />   <br />   (if (= ent_nam "LWPOLYLINE")(progn<br />     (xdrx_SetEntToDb ent_in)<br />     (while (setq pt (xdrx_getpolyvtx))<br />         (setq pt_lst (cons pt pt_lst))<br />     );while<br /> <br />     (setq n 1)<br />     (setq pt_lst (cdr pt_lst)<br />           pt_lst (reverse pt_lst)<br />           pto (car pt_lst)<br />           pt_lst (cdr pt_lst))<br />     (foreach ptx pt_lst<br />       (if (< (distance ptx pto) dist_in)<br />         (progn<br />           (xdrx_polyline_removeVertexAt ent_in n)<br />           (setq n (1- n))<br />         )<br />         (setq pto ptx)<br />       );if<br />       (setq n (1+ n))<br />     );foreach<br />   ));if<br /> );end<br /> <br /> (defun pline_checkang (ent_in ang_in / ent_nam pt pt_lst n m angr pat ptb ptc<br />                        ang1 ang2 angc)<br />   (if ent_in<br />     (setq ent_nam (cdr (assoc 0 (entget ent_in))))<br />   );if<br />   <br />   (if (= ent_nam "LWPOLYLINE")(progn<br />     (xdrx_SetEntToDb ent_in)<br />     (while (setq pt (xdrx_getpolyvtx))<br />         (setq pt_lst (cons pt pt_lst))<br />     );while<br />     <br />     (setq pt_lst (reverse pt_lst))<br />     (setq n 0 m 1)<br />     ;(setq angr (/ (* pi ang_in) 180))<br />     (setq angr (- pi ang_in))<br />     (setq pta (nth n pt_lst))<br />     <br />     (setq len1 (- (length pt_lst) 2))<br />     (repeat len1<br />       (setq ptc (nth (1+ n) pt_lst)<br />             ptb (nth (+ n 2) pt_lst)<br />             ang1 (angle ptc pta)<br />             ang2 (angle ptc ptb)<br />             angc (abs(- ang2 ang1)))<br /> <br />       (if (> angc angr)<br />         (progn<br />           (xdrx_polyline_removeVertexAt ent_in m)<br />         );progn<br />         (setq m (1+ m)<br />               pta ptc)<br />       );if<br />       (setq n (1+ n))<br />     );repeat<br />   ));if<br /> );end<br />

fjw_ok

高手！
要vba编的话可先把点放到ARRY( )中
剩下的就是数学问题了！

cy956

见expresstools里头的overkill的Numeric fuzz 值。

The Numeric Fuzz value allows you to control the precision with which OVERKILL makes numeric comparisons. If this value is 0, the two objects being compared must match before OVERKILL will delete or modify one of them. On the other hand, if the fuzz value is higher than 0, the two objects being compared do not have to match for one of them to be deleted or modified

god

高，实在是高，

原来这个主题移到 ※VBA、COM-ActiveX Interfaces 开发技术※ 里面去了， 后面的跟帖一直没有邮件通知，我还不知道有高手已经解决了这个问题呢。
建议斑竹检查一下是什么原因。

老头1989

确是高手

god

不过A方式处理有点问题，看这个由line组成的园的处理，控制夹角是1度，变成了半圆了。