请教一个统一左上角起点的问题
本帖最后由 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)
)
)
)
每次循环,ptlist 没有重置吧 谢谢指点,先尝试看看。 记下,到时候可能有用
页:
[1]