请教一个统一左上角起点的问题

434939575

2. 请教一个问题，目标是统一变起点为左上角。批量时出乱了，感觉是图元之间表没有分离，合到一起了。
   
3. 请大师帮帮忙，感谢！
   
4. (defun C:tt (/ ss ename elist ptlist   )  ;多段线左上角为起始点，
   
5.   (setq ss (ssget))
   
6.   (setq i 0)
   
7.   (repeat (sslength ss)
   
8.     (setq ss0   (ssname ss i)
   
9.     ss0-en (entget ss0)
   
10.     i   (1+ i)
    
11.     )
    
12.     (foreach n ss0-en                    
    
13.       (if (= 10 (car n))
    
14.                              
    
15.   
    
16.   (setq ptlist
    
17.          (cons   
    
18.      (cdr n)
    
19.      ptlist
    
20.          )
    
21.   )
    
22.       )  ;if
    
23.     )  ;foreach
    
24.     (reverse ptlist)
    
25.     (setq list-y
    
26.      (vl-sort ptlist
    
27.         (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))
    
28.      )
    
29.     )
    
30. ;;;Y----小到大;
    
31.     (setq y-1 (car list-y))
    
32. ;;;Y----第一个点;
    
33.     (setq y-2 (cadr list-y))
    
34. ;;;Y----第二个点;
    
35.     (setq list-y++ (append (list y-1) (list y-2)))
    
36. ;;;Y----第一二个点组合;
    
37.     (setq memb-1
    
38.      (car
    
39.        (vl-sort list-y++
    
40.           (function (lambda (e1 e2) (< (car e1) (car e2))))
    
41.        )
    
42.      )
    
43.     )
    
44. ;;;Y--表里面重新排列取靠左边的点;      
    
45.     (setq lst-ab (member memb-1 ptlist))
    
46.     (setq lst-cd (reverse (cdr (member memb-1 (reverse ptlist)))))         
    
47.     (setq list-ok (append lst-ab lst-cd))   
    
48.     (command "circle" memb-1 500 "");此圆用于测试起点的位置
    
49. 
    
50.     (Make-LWPOLYLINE list-ok  )
    
51.   );repeat
    
52.    (command "_.erase" ss "");删除原始的图元
    
53. )
    
54. ;;164.31 [功能] 点表生成多段线
    
55. (defun Make-LWPOLYLINE (lst /  PT )
    
56.   (entmake (append (list '(0 . "LWPOLYLINE")
    
57.        '(100 . "AcDbEntity")
    
58.        '(100 . "AcDbPolyline")
    
59.        (cons 90 (length lst)) ;端点数量
    
60.        '(70 . 1)  ;关闭图形
    
61.        )
    
62.        (mapcar '(lambda (pt) (cons 10 pt)) lst)
    
63. 
    
64. 
    
65.      )
    
66.   )
    
67. )
    

请教一个问题，目标是统一变起点为左上角。批量时出乱了，感觉是图元之间表没有分离，合到一起了。<br /> 请大师帮帮忙，感谢！<br /> (defun C:tt (/ ss ename elist ptlist   )  ;多段线左上角为起始点，<br />   (setq ss (ssget))<br />   (setq i 0)<br />   (repeat (sslength ss)<br />     (setq ss0   (ssname ss i)<br />     ss0-en (entget ss0)<br />     i   (1+ i)<br />     )<br />     (foreach n ss0-en                    <br />       (if (= 10 (car n))<br />                              <br />   <br />   (setq ptlist<br />          (cons    <br />      (cdr n)<br />      ptlist<br />          )<br />   )<br />       )  ;if<br />     )  ;foreach <br />     (reverse ptlist)<br />     (setq list-y<br />      (vl-sort ptlist<br />         (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))<br />      )<br />     )<br /> ;;;Y----小到大;<br />     (setq y-1 (car list-y))<br /> ;;;Y----第一个点;<br />     (setq y-2 (cadr list-y))<br /> ;;;Y----第二个点;<br />     (setq list-y++ (append (list y-1) (list y-2)))<br /> ;;;Y----第一二个点组合;<br />     (setq memb-1<br />      (car<br />        (vl-sort list-y++<br />           (function (lambda (e1 e2) (< (car e1) (car e2))))<br />        )<br />      )<br />     )<br /> ;;;Y--表里面重新排列取靠左边的点;      <br />     (setq lst-ab (member memb-1 ptlist))<br />     (setq lst-cd (reverse (cdr (member memb-1 (reverse ptlist)))))          <br />     (setq list-ok (append lst-ab lst-cd))    <br />     (command "circle" memb-1 500 "");此圆用于测试起点的位置<br /> <br />     (Make-LWPOLYLINE list-ok  )<br />   );repeat<br />    (command "_.erase" ss "");删除原始的图元<br /> )<br /> ;;164.31 [功能] 点表生成多段线<br /> (defun Make-LWPOLYLINE (lst /  PT )<br />   (entmake (append (list '(0 . "LWPOLYLINE")<br />        '(100 . "AcDbEntity")<br />        '(100 . "AcDbPolyline")<br />        (cons 90 (length lst)) ;端点数量<br />        '(70 . 1)  ;关闭图形<br />        )<br />        (mapcar '(lambda (pt) (cons 10 pt)) lst)<br /> <br /> <br />      )<br />   )<br /> )<br />

dunkel

每次循环，ptlist 没有重置吧

434939575

谢谢指点，先尝试看看。

tangjunasd58

记下，到时候可能有用