树櫴希德 发表于 2017-12-12 15:16:20

方格排序 感谢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)
)

树櫴希德 发表于 2017-12-12 15:50:14

欢迎下载 改进

winerfjy 发表于 2017-12-25 23:38:42

好贴！估计楼主也花了不少时间写这个代码

13648893846 发表于 2017-12-29 08:59:30

选择直线起点是只能选择最北的直线并且得从右往左选择,不然就出错,能否优化一下

血司 发表于 2018-1-4 16:40:45

血司 发表于 2018-1-4 16:48:28

本帖最后由 血司 于 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)
)

zst1978 发表于 2021-12-16 12:12:53

非常谢谢大侠分享

skg123 发表于 2022-5-6 16:38:24

你就是测绘板块的 劳模

z312144636 发表于 2024-5-9 14:02:03

非常谢谢大侠分享

czb203 发表于 2024-6-12 15:32:54

(setq fgjj (getint "\n请输入方格间距(输入整数)："));输入整数
这句话的意义是什么呀，能不能帮忙解释下~
页: [1]
查看完整版本: 方格排序 感谢73哥等大神函数