434939575 发表于 2014-5-6 14:21:35

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

本帖最后由 434939575 于 2014-5-6 14:26 编辑

请教一个问题,目标是统一变起点为左上角。批量时出乱了,感觉是图元之间表没有分离,合到一起了。
请大师帮帮忙,感谢!
(defun C:tt (/ ss ename elist ptlist   );多段线左上角为起始点,
(setq ss (ssget))
(setq i 0)
(repeat (sslength ss)
    (setq ss0   (ssname ss i)
    ss0-en (entget ss0)
    i   (1+ i)
    )
    (foreach n ss0-en                  
      (if (= 10 (car n))
                           

(setq ptlist
         (cons   
   (cdr n)
   ptlist
         )
)
      );if
    );foreach
    (reverse ptlist)
    (setq list-y
   (vl-sort ptlist
      (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))
   )
    )
;;;Y----小到大;
    (setq y-1 (car list-y))
;;;Y----第一个点;
    (setq y-2 (cadr list-y))
;;;Y----第二个点;
    (setq list-y++ (append (list y-1) (list y-2)))
;;;Y----第一二个点组合;
    (setq memb-1
   (car
       (vl-sort list-y++
          (function (lambda (e1 e2) (< (car e1) (car e2))))
       )
   )
    )
;;;Y--表里面重新排列取靠左边的点;      
    (setq lst-ab (member memb-1 ptlist))
    (setq lst-cd (reverse (cdr (member memb-1 (reverse ptlist)))))         
    (setq list-ok (append lst-ab lst-cd))   
    (command "circle" memb-1 500 "");此圆用于测试起点的位置

    (Make-LWPOLYLINE list-ok)
);repeat
   (command "_.erase" ss "");删除原始的图元
)
;;164.31 [功能] 点表生成多段线
(defun Make-LWPOLYLINE (lst /PT )
(entmake (append (list '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
       (cons 90 (length lst)) ;端点数量
       '(70 . 1);关闭图形
       )
       (mapcar '(lambda (pt) (cons 10 pt)) lst)


   )
)
)

dunkel 发表于 2014-5-6 15:36:47

每次循环,ptlist 没有重置吧

434939575 发表于 2014-5-6 16:05:55

谢谢指点,先尝试看看。

tangjunasd58 发表于 2015-7-27 09:38:26

记下,到时候可能有用
页: [1]
查看完整版本: 请教一个统一左上角起点的问题