[LISP程序]：高手帮我找找错。

xstlf

我自编了一个清理门窗的小程序。但就是出现一点小问题，找来找去找不到原因，高手帮我看看我的程序呀。

xyp1964

不知有啥问题？

nore

运行时所选物元会被删掉，但是提示有错误
楼主想要的是什么效果？

xstlf

我是打算把“W”选中的都删除掉，把C选中的那些平行直线两两相连成一条直线。

xstlf

如下图。

xstlf

改成这图。

david96007

2. 
   
3. (defun c:smc (/ pt1 pt2 ss1 n i ents j ent1 ent2 pts)
   
4.   (setq osm (getvar "osmode"))
   
5.   (setvar "osmode" 0)
   
6.   (setq        pt1 (getpoint "\输入要删除门窗的窗口起始点:")
   
7.         pt2 (getcorner pt1 "\n输入窗口的另一点:")
   
8.   ) ;_ end of setq
   
9.   (setq ss1 (ssget "W" pt1 pt2))
   
10.   (command "_.erase" ss1 "")
    
11.   (setq
    
12.     ss1        (ssget "C" pt1 pt2 '((0 . "line") (8 . "墙体")))
    
13.   ) ;_ end of setq
    
14.   (setq n (sslength ss1))
    
15.   (setq i 0) ;_ end of setq
    
16.   (while (< i n)
    
17.     (setq j (1+ i))
    
18.     (setq enti (ssname ss1 i))
    
19.     (while (< j n)
    
20.       (progn (setq entj (ssname ss1 j))
    
21.              (setq pts (lianxian enti entj))
    
22.              (princ "\n pts")(princ pts)
    
23.              (setq j (+ j 1))
    
24.       ) ;_ end of progn
    
25.     ) ;_ end of while
    
26.     (setq i (+ i 1))
    
27.     (princ "\ni=")
    
28.     (princ i)
    
29.   ) ;_ end of while
    
30.   (command "_.erase" ss1 "")
    
31.   (princ)
    
32.   (setvar "osmode" osm)
    
33. ) ;_ end of defun
    
34. (defun lianxian        (ent1  ent2  /           name1 name2 pta1  ptb1
    
35.                  pta2  ptb2  ang1  ang2         ang3  da    db
    
36.                  dc    dd    m
    
37.                 )
    
38.   (setq        name1 (entget ent1)
    
39.         name2 (entget ent2)
    
40.   ) ;_ end of setq
    
41.   (setq        pta1 (cdr (assoc 10 name1))
    
42.         ptb1 (cdr (assoc 11 name1))
    
43.         pta2 (cdr (assoc 10 name2))
    
44.         ptb2 (cdr (assoc 11 name2))
    
45.   ) ;_ end of setq
    
46.   (setq        ang1 (angle pta1 ptb1)
    
47.         ang2 (angle pta1 ptb2)
    
48.   ) ;_ end of setq
    
49.   (if (< (abs (- ang1 ang2)) 0.0000001)
    
50.     (progn (setq da (distance pta1 pta2)
    
51.                  db (distance pta1 ptb2)
    
52.                  dc (distance ptb1 pta2)
    
53.                  dd (distance ptb1 ptb2)
    
54.            ) ;_ end of setq
    
55.            (setq m (max da db dc dd))
    
56.            (if (= m da)
    
57.              (command "_.line" pta1 pta2 "")
    
58.              (if (= m db)
    
59.                (command "_.line" pta1 ptb2 "")
    
60.                (if (= m dc)
    
61.                  (command "_.line" ptb1 pta2 "")
    
62.                  (if (= m dd)
    
63.                    (command "_.line" ptb1 ptb2 "")
    
64.                  ) ;_ end of if
    
65.                ) ;_ end of if
    
66.              ) ;_ end of if
    
67.            ) ;_ end of if
    
68.     ) ;_ end of progn
    
69.   ) ;_ end of if
    
70. ) ;_ end of defun
    

<br /> (defun c:smc (/ pt1 pt2 ss1 n i ents j ent1 ent2 pts)<br />   (setq osm (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (setq        pt1 (getpoint "\输入要删除门窗的窗口起始点:")<br />         pt2 (getcorner pt1 "\n输入窗口的另一点:")<br />   ) ;_ end of setq<br />   (setq ss1 (ssget "W" pt1 pt2))<br />   (command "_.erase" ss1 "")<br />   (setq<br />     ss1        (ssget "C" pt1 pt2 '((0 . "line") (8 . "墙体")))<br />   ) ;_ end of setq<br />   (setq n (sslength ss1))<br />   (setq i 0) ;_ end of setq<br />   (while (< i n)<br />     (setq j (1+ i))<br />     (setq enti (ssname ss1 i))<br />     (while (< j n)<br />       (progn (setq entj (ssname ss1 j))<br />              (setq pts (lianxian enti entj))<br />              (princ "\n pts")(princ pts)<br />              (setq j (+ j 1))<br />       ) ;_ end of progn<br />     ) ;_ end of while<br />     (setq i (+ i 1))<br />     (princ "\ni=")<br />     (princ i)<br />   ) ;_ end of while<br />   (command "_.erase" ss1 "")<br />   (princ)<br />   (setvar "osmode" osm)<br /> ) ;_ end of defun<br /> (defun lianxian        (ent1  ent2  /           name1 name2 pta1  ptb1<br />                  pta2  ptb2  ang1  ang2         ang3  da    db<br />                  dc    dd    m<br />                 )<br />   (setq        name1 (entget ent1)<br />         name2 (entget ent2)<br />   ) ;_ end of setq<br />   (setq        pta1 (cdr (assoc 10 name1))<br />         ptb1 (cdr (assoc 11 name1))<br />         pta2 (cdr (assoc 10 name2))<br />         ptb2 (cdr (assoc 11 name2))<br />   ) ;_ end of setq<br />   (setq        ang1 (angle pta1 ptb1)<br />         ang2 (angle pta1 ptb2)<br />   ) ;_ end of setq<br />   (if (< (abs (- ang1 ang2)) 0.0000001)<br />     (progn (setq da (distance pta1 pta2)<br />                  db (distance pta1 ptb2)<br />                  dc (distance ptb1 pta2)<br />                  dd (distance ptb1 ptb2)<br />            ) ;_ end of setq<br />            (setq m (max da db dc dd))<br />            (if (= m da)<br />              (command "_.line" pta1 pta2 "")<br />              (if (= m db)<br />                (command "_.line" pta1 ptb2 "")<br />                (if (= m dc)<br />                  (command "_.line" ptb1 pta2 "")<br />                  (if (= m dd)<br />                    (command "_.line" ptb1 ptb2 "")<br />                  ) ;_ end of if<br />                ) ;_ end of if<br />              ) ;_ end of if<br />            ) ;_ end of if<br />     ) ;_ end of progn<br />   ) ;_ end of if<br /> ) ;_ end of defun<br />