方格排序 感谢73哥等大神函数
方格排序 感谢73哥等大神函数(defun zxzb (pts / len pt )(setq len (length pts))
(setq pt (mapcar
'(lambda(x)
(/ x len)
)
(apply
'mapcar
(cons '+ pts)
)
)
)pt)
(defun Plinexy(e / p a b n ob q et d d1 en et)
(setq a(entget e)ob(vlax-ename->vla-object e)et(cdr(assoc 0 a))n 0 p nil d nil)
(cond((="LWPOLYLINE"et)
(repeat(length a)(setq b (nth n a) n (+ n 1))
(if (= 10 (car b))(progn
(setq q(list (cadr b) (caddr b))d1(vlax-curve-getDistAtPoint ob q))
(if p (if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))
(setq p (list q)))))))
((="POLYLINE"et)
(SETQ EN (ENTGET (SETQ E (ENTNEXT E))))
(WHILE (/= (CDR (ASSOC 0 EN)) "SEQEND")
(SETQ q (CDR (ASSOC 10 EN))d1(vlax-curve-getDistAtPoint ob q)q(reverse(cdr(reverse q))))
(if p(if (not(member d1 d)) (setq p (append p (list q))d (append d (list d1))))(setq p(list q)))
(SETQ EN (ENTGET (SETQ E (ENTNEXT E)))))
(setq p(reverse p))))P)
(defun cx-ss2en
(ss / enlst)
(cond
((= (type ss) 'PICKSET)
(vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
)
((= (type ss) 'LIST)
(setq enlst (ssadd))
(last (mapcar '(lambda (x) (ssadd x enlst)) ss))
)
((='ename(type ss))
(ssadd ss)
)
)
)
;;;;;;;;;;;;;;;;;;
(defun t2t (p1 p2 p3 / p1 p2 p3) ;点到直线距离1
(abs (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1))))
) ;;;;;;;;;;;;;;;;
(defun t1t (p1 p2 p3 / p1 p2 p3) ;点到直线距离2
(car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:szpx (/ ssa kongbiao i ii zb paixuzb p1 p2 fgjj p3 cishu kb kbb iii)
(setq ssa (ssget "x"'( (0 . "polyline")(8 . "tf-fg1") ) ) )
(setq kongbiao '()) (setq i 0)
(foreach x (cx-ss2en ssa)
(setq zb (zxzb(plinexy x))) (setq kongbiao (append (list zb) kongbiao)) (setq i (1+ i))
)
(setq paixuzb (vl-sort kongbiao
(function (lambda (e1 e2) (> (cadr e1)(cadr e2 ) )
) ) )
)
(setq p1 (getpoint "\n请选择直线起点："))
(setq p2 (getpoint "\n请选择直线第二点："))
(setq fgjj (getint "\n请输入方格间距(输入整数)："));输入整数
(setq p3 (last paixuzb))
(setq cishu (+ 2 (fix (/ (t2t p1 p2 p3) fgjj )) ) )
(setq kb '()) (setq ii 0)
(repeat cishu
(setq kbb
(vl-sort (vl-remove-if-not(FUNCTION (LAMBDA (A1) (< (* -1 fgjj) (t1t (polar p1 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) (polar p2 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) A1) 0) ))kongbiao)
(function (lambda (e1 e2) (> (car e1)(car e2 ) )
) ) )
)
(setq kb (append kbb kb))
(setq ii (1+ ii))
)
(setq iii 0)
(foreach n (reverse kb)
(entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos (+ iii 1) 2 0)) (cons 10 n ) (cons 40 1.0)))
(entmake (list '(0 . "circle") '(8 . "fgbj")(cons 62 3) (cons 10 n ) (cons 40 1.0)))
(setq iii (1+ iii))
)
(princ)
)
欢迎下载 改进
好贴！估计楼主也花了不少时间写这个代码 选择直线起点是只能选择最北的直线并且得从右往左选择,不然就出错,能否优化一下 本帖最后由 血司 于 2018-1-5 09:36 编辑
(defun c:lxybh (/ str k qz ss xxpx xxss zg)
(setq ss (ssget (list '(0 . "*LWPOLYLINE")))
zg (getreal"\n请输入标注字高：")
qz (getstring"\n请输入前缀：")
)
(setq xxss nil)
(foreach cc (lxy-ss->list ss)
(setq xxss (append (list (lxy-poly-cen (lxy-poly-pts cc))) xxss))
)
(setq xxpx (lxy-pts-xy xxss 1 0))
(setq k 0)
(foreach aa xxpx
(if (= qz nil)
(setq str (itoa (1+ k)))
(setq str (strcat qz (itoa (1+ k))))
)
(maketext aa str zg)
)
(princ)
)
非常谢谢大侠分享 你就是测绘板块的 劳模 非常谢谢大侠分享
页:
[1]