[原创]：任意线转POLYLINE程序2pl.lsp（公布源码！）

hmh888888

我把直线生成多义线，顶点不是按顺序的，难以编辑
相交的直线能不能连成一根线呢？

xyp1964

最初由 hmh888888 发布
[B]我把直线生成多义线，顶点不是按顺序的，难以编辑
相交的直线能不能连成一根线呢？ [/B]

用pedit命令！
xxxyzxx：对你的三超问题，晕倒！

xxxyzxx

1.老大的信箱
本论坛信箱已满，无法发信件
xyp@bsedi.com信箱不存在吧？

2.
新版2PL比较完美，就是速度慢；
应该是代码增加的结果吧，但是怎么一下子慢了那么多（幸好还有旧版存货）

3.Qlin 编的一个程序
功能没有老大的强大，但是某些思路不错；

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

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

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

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

说明：需配合XDRX API使用

[PHP]
(defun c:plclean (/ ss key n num ent1)
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (initget "D A")
      (setq key (getkword "\n选择优化方式[按照距离(D)/按照角度(A)]: "))
      (if (not key)(setq key "D"))
      (cond
        (  (= key "D")
          (while (not num)
            (setq num (getdist "\n  输入最小点距: "))
          );while
          (setq n 0)
          (repeat (sslength ss)
            (setq ent1 (ssname ss n))
            (pline_checkdist ent1 num)
            (setq n (1+ n))
          );repeat
        )
        (  (= key "A")
          (while (not num)
            (setq num (getangle "\n  输入最小夹角: "))
          );while
          (setq n 0)
          (repeat (sslength ss)
            (setq ent1 (ssname ss n))
            (pline_checkang ent1 num)
            (setq n (1+ n))
          );repeat
        )
      );cond
      (princ "\n  共清理了")(princ (sslength ss))(princ "条多义线")
    );progn
  );if
  (princ)
);end

(defun pline_checkdist (ent_in dist_in / ent_nam pt pt_lst pto ptx n pte)
  (if ent_in
    (setq ent_nam (cdr (assoc 0 (entget ent_in))))
  );if
  
  (if (= ent_nam "LWPOLYLINE")(progn
    (xdrx_SetEntToDb ent_in)
    (while (setq pt (xdrx_getpolyvtx))
        (setq pt_lst (cons pt pt_lst))
    );while

    (setq n 1)
    (setq pt_lst (cdr pt_lst)
          pt_lst (reverse pt_lst)
          pto (car pt_lst)
          pt_lst (cdr pt_lst))
    (foreach ptx pt_lst
      (if (< (distance ptx pto) dist_in)
        (progn
          (xdrx_polyline_removeVertexAt ent_in n)
          (setq n (1- n))
        )
        (setq pto ptx)
      );if
      (setq n (1+ n))
    );foreach
  ));if
);end

(defun pline_checkang (ent_in ang_in / ent_nam pt pt_lst n m angr pat ptb ptc
                       ang1 ang2 angc)
  (if ent_in
    (setq ent_nam (cdr (assoc 0 (entget ent_in))))
  );if
  
  (if (= ent_nam "LWPOLYLINE")(progn
    (xdrx_SetEntToDb ent_in)
    (while (setq pt (xdrx_getpolyvtx))
        (setq pt_lst (cons pt pt_lst))
    );while
   
    (setq pt_lst (reverse pt_lst))
    (setq n 0 m 1)
    ;(setq angr (/ (* pi ang_in) 180))
    (setq angr (- pi ang_in))
    (setq pta (nth n pt_lst))
   
    (setq len1 (- (length pt_lst) 2))
    (repeat len1
      (setq ptc (nth (1+ n) pt_lst)
            ptb (nth (+ n 2) pt_lst)
            ang1 (angle ptc pta)
            ang2 (angle ptc ptb)
            angc (abs(- ang2 ang1)))

      (if (> angc angr)
        (progn
          (xdrx_polyline_removeVertexAt ent_in m)
        );progn
        (setq m (1+ m)
              pta ptc)
      );if
      (setq n (1+ n))
    );repeat
  ));if
);end
[/PHP]

感谢老大的帮助，线条太多，直到今天才开始进MAX生成地形，发现了“二大类”典型问题，附图说明，并上传文件
一：
原线为闭合线
新生成的线不是闭合线，有开口，且有"回线重复问题"
二：
原线为非相交的2条闭合线
新生成的2条线平面图有相交问题（即3D图中有突如其来的锐角）
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
本来捉了图，但这里贴图就不能发附件，还是存个给老大看更清晰直观

xyp1964

最初由 **yzxx 发布
[B]1.老大的信箱
本论坛信箱已满，无法发信件
信箱不存在吧？

2.
新版2PL比较完美，就是速度慢；
应该是代码增加的结果吧，但是怎么一下子慢了那么多（幸好还有旧版存货）

3.Qli... [/B]

1. 原线为非闭合线，且有重复段（红色部分）！
新生成的线当然不是闭合线，有开口，且有“回线重复问题”！

2. 设两点距离（数值）为20或10！
当然可能影响速度。

“三超”问题已修改，提速！

xxxyzxx

谢谢老大，恭喜老大升级为支柱会员！

新问题：同27楼
1204版不能正常使用（代码也比原来版的少了）
命令: 2pl
; 错误: no function definition: CMDLA0

旧问题1＋：如何判断是否闭合曲线
不知老大是如何发现的，我使LIST查点累死（绘图人说是闭合线，没想到竟然不是）；
OVERKILL可以删重线，但删后线段碎乱，望老大作个好LISP，把看似闭合线的线作OVERKILL处理，并形成新的闭合线。（最好是批量处理的～）

旧问题2＋：如何判断距离该用多大，10、20还是50、100，能否编LISP辅助判断？

旧问题3＋：Qlin 编的程序中，针对角度的优化老大是否可以加入？

xyp1964

最初由 xxxyzxx 发布
[B]谢谢老大，恭喜老大升级为支柱会员！

新问题：同27楼
1204版不能正常使用（代码也比原来版的少了）
命令: 2pl
; 错误: no function definition: CMDLA0

旧问题1＋：如何判断是否闭合曲线
不知老大是如何发... [/B]

“1204版不能正常使用”是因为有函数未定义，这是偶经常犯的错误，通用函数在本机已自动加载。

程序并未判断是否闭合曲线，如果出现“回线重复问题”肯定是原线有问题，程序本身并不能多余生成其他线。

旧问题2＋：如何判断距离该用多大，10、20还是50、100，能否编LISP辅助判断？
只能自己判断，因为最终效果要由用户决定，况且等高线之间的距离是不定的。

旧问题3＋：Qlin 编的程序中，针对角度的优化老大是否可以加入？
不会加入，呵呵……

xxxyzxx

感谢老大！
1.不是问题的问题（我想这个要凭个人经验去解决了）
经测试，1205版好使，开始速度也很快，并能看到线条生成刷刷，近似于1130版（总体感觉稍慢一点点）；但后续运算不理想，不能像1202版一样运算出结果（1204版未运算出结果CAD已经死掉）
2.旧问题1＋＋：如何判断是否闭合曲线
希望老大能单独制作个LISP
目的：1＋，并重新生成闭合线
功能：选中所有PLINE，使用PEDIT命令看其是否有闭合（C）选项，如无且有（O）选项，应该可以判断是闭合线了吧？（由于不能判断是否有重段，希望老大加个功能使其能在内部自动选点，并重新生成闭合线）

xyp1964

最初由 xxxyzxx 发布
[B]感谢老大！
1.不是问题的问题（我想这个要凭个人经验去解决了）
经测试，1205版好使，开始速度也很快，并能看到线条生成刷刷，近似于1130版（总体感觉稍慢一点点）；但后续运算不理想，不能像1202版一样运算出结果... [/B]

速度慢的问题：距离值不要太小。
非闭合曲线，重新生成闭合线：会导致起点到端点产生线，这不是程序的原意。

xyp1964

最初由 bluestarqq 发布
[B]很想要的东西，可惜用的是R14，能不能出个支持R14的啊！ [/B]

R14不容易实现此功能！

stone0030

请问各位大哥，下载“2pl.fas”可以运行，但我想看程序的源文件应该如何查看

xyp1964

各位大哥，不包括偶，估计暂时看不了程序的源文件。呵呵……

lewis240

老大！在转圆的时候有问题！
会出现断开的现象

xyp1964

最初由 lewis240 发布
[B]老大！在转圆的时候有问题！
会出现断开的现象 [/B]

在2004版测试通过。
没有问题：

xjlmlxbq

最初由 xyp1964 发布
[B]各位大哥，不包括偶，估计暂时看不了程序的源文件。呵呵…… [/B]

老大,什么时间可以公布源代码.嘿嘿

xyp1964

觉得这个程序没什么“前途”了，还是抛砖引玉吧！
就今天、现在公布程序源码。
下载程序，到1楼！