大家一起来除错，大家一起来优化

xiaowa

大家一起来除错，大家一起来优化

2. ;;这是一个关于删除pline线中多余点的小小程序，但是总运行出错，请大侠们see……see……
   
3. ;;====================================================================
   
4. ;;删除顶点
   
5. (defun delp (ent pt)                ;ent为选择的线 ents为扩展数据 pt为要删除的点
   
6.   (princ "要删除一个点")
   
7.   (setq ents (entget ent))
   
8.   (setq lst (member (cons 10 pt) ents))
   
9.   (if lst
   
10.     (progn
    
11.       (setq lst        (list (assoc 10 lst)
    
12.                       (assoc 40 lst)
    
13.                       (assoc 41 lst)
    
14.                       (assoc 42 lst)
    
15.                 )
    
16.       )
    
17.       (setq i 0)
    
18.       (repeat 4
    
19.         (setq ents (vl-remove (nth i lst) ents))
    
20.         (setq i (1+ i))
    
21.       )
    
22.     )
    
23.   )
    
24.   (entmod ents)
    
25.   (princ "删除一个点")
    
26.   (princ)
    
27. )
    
28. 
    
29. ;;====================================================================
    
30. ;;优化pline线
    
31. (defun C:N7 ()
    
32.   (vl-load-com)
    
33.   (setq ss1 (ssget '((0 . "*polyline"))))
    
34.   (setq        nn1 (sslength ss1)                ;赋值ii1=0,nn1是子集ss1的数目
    
35.         ii1 0
    
36.   )
    
37.   ;;ss1为选择集、ss2为图元、ss3为ename的图元（扩展数据）、ss4为第ii3个扩展数据
    
38.   (while (< ii1 nn1)
    
39.     (setq ss2 (ssname ss1 ii1))                ;对第ii1个图元进行分析
    
40.     (setq ss3 (entget ss2))
    
41.     (setq nn3 (length ss3)
    
42.           ii3 0
    
43.           pt1 nil
    
44.           pt2 nil
    
45.           pt3 nil
    
46.           ptf nil                        ;第一点以备后用
    
47.           pts nil                        ;第二点以备后用
    
48.     )
    
49.     (while (< ii3 nn3)                        ;顺序读取各个扩展信息
    
50.       (setq ss4 (nth ii3 ss3))                ;第ii3个扩展信息表放入ss4中
    
51.       ;;读取为10的扩展信息，即坐标信息
    
52.       (if (= (car ss4) 10)
    
53.         (progn
    
54.           (setq ss4 (cdr ss4))
    
55.           (setq pt1 pt2)
    
56.           (setq pt2 pt3)
    
57.           (setq pt3 ss4)
    
58. 
    
59.           (if (= pts nil)
    
60.             (if        (= ptf nil)
    
61.               (setq ptf ss4)
    
62.               (setq pts ss4)
    
63.             )
    
64.             ;;看pt2是否是多余的点
    
65.             (if        (equal (+ (distance pt2 pt1) (distance pt2 pt3))
    
66.                        (distance pt1 pt3)
    
67.                        0.000001
    
68.                 )
    
69.               (progn
    
70.                 (princ "ok")
    
71.                 (delp (ss2 pt2))
    
72.               )
    
73.             )
    
74.           )
    
75.         )
    
76.       )
    
77.       (setq ii3 (+ ii3 1))
    
78.     )
    
79.     (setq ii1 (+ ii1 1))
    
80.   )
    
81.   (princ "PLine线优化完毕！")
    
82.   (princ)
    
83. )
    
84. 
    
85. ;;====================================================================

;;这是一个关于删除pline线中多余点的小小程序，但是总运行出错，请大侠们see……see……<br /> ;;====================================================================<br /> ;;删除顶点<br /> (defun delp (ent pt)                ;ent为选择的线 ents为扩展数据 pt为要删除的点<br />   (princ "要删除一个点")<br />   (setq ents (entget ent))<br />   (setq lst (member (cons 10 pt) ents))<br />   (if lst<br />     (progn<br />       (setq lst        (list (assoc 10 lst)<br />                       (assoc 40 lst)<br />                       (assoc 41 lst)<br />                       (assoc 42 lst)<br />                 )<br />       )<br />       (setq i 0)<br />       (repeat 4<br />         (setq ents (vl-remove (nth i lst) ents))<br />         (setq i (1+ i))<br />       )<br />     )<br />   )<br />   (entmod ents)<br />   (princ "删除一个点")<br />   (princ)<br /> )<br /> <br /> ;;====================================================================<br /> ;;优化pline线<br /> (defun C:N7 ()<br />   (vl-load-com)<br />   (setq ss1 (ssget '((0 . "*polyline"))))<br />   (setq        nn1 (sslength ss1)                ;赋值ii1=0,nn1是子集ss1的数目<br />         ii1 0<br />   )<br />   ;;ss1为选择集、ss2为图元、ss3为ename的图元（扩展数据）、ss4为第ii3个扩展数据<br />   (while (< ii1 nn1)<br />     (setq ss2 (ssname ss1 ii1))                ;对第ii1个图元进行分析<br />     (setq ss3 (entget ss2))<br />     (setq nn3 (length ss3)<br />           ii3 0<br />           pt1 nil<br />           pt2 nil<br />           pt3 nil<br />           ptf nil                        ;第一点以备后用<br />           pts nil                        ;第二点以备后用<br />     )<br />     (while (< ii3 nn3)                        ;顺序读取各个扩展信息<br />       (setq ss4 (nth ii3 ss3))                ;第ii3个扩展信息表放入ss4中<br />       ;;读取为10的扩展信息，即坐标信息<br />       (if (= (car ss4) 10)<br />         (progn<br />           (setq ss4 (cdr ss4))<br />           (setq pt1 pt2)<br />           (setq pt2 pt3)<br />           (setq pt3 ss4)<br /> <br />           (if (= pts nil)<br />             (if        (= ptf nil)<br />               (setq ptf ss4)<br />               (setq pts ss4)<br />             )<br />             ;;看pt2是否是多余的点<br />             (if        (equal (+ (distance pt2 pt1) (distance pt2 pt3))<br />                        (distance pt1 pt3)<br />                        0.000001<br />                 )<br />               (progn<br />                 (princ "ok")<br />                 (delp (ss2 pt2))<br />               )<br />             )<br />           )<br />         )<br />       )<br />       (setq ii3 (+ ii3 1))<br />     )<br />     (setq ii1 (+ ii1 1))<br />   )<br />   (princ "PLine线优化完毕！")<br />   (princ)<br /> )<br /> <br /> ;;====================================================================

xiaowa

为什么没有人指教呢？

xiaowa

版主。。帮忙看看嘛

meflying

delp函数有问题，这个函数好象是我写的，是有问题的，龙版主已经指出了，你应该看看对于某个问题的每个回帖，可能就会有一些改正或完善的地方。。。

说明，这个函数在vl-remove是，如果40 41 42 如果有相同的都会被删掉，导致错误。。。

另指正一下概念：ents是ent的定义数据，不是扩展数据，扩展数据是另外一个东西。。。