请教ZZXXQQ：为块排序

dinosaurhxe

看了您回复的如何获取块属性和如何替换块属性的贴，想请您解决这个问题。

根据块的X坐标大小进行排序，若X坐标相同则根据Y坐标，如图。

我的初步想法是：
　　选择集选择需要排序的块（或者输入块名自动选择）→提示输入需要排序的属性（若只有一个则自动选择）→提示根据X坐标由大到小或者由小到大排序→排序→改写块属性为序号

请指教，谢谢！

yxl88168

感谢楼主的无私分享

ivde

2. (defun c:tt ()
3.   (vl-catch-all-apply
4.     '(lambda (/ blk num)
5.        (vla-eval (vlax-get-acad-object) "Thisdrawing.Activeselectionset.Delete")
6.        (if (ssget '((0 . "insert") (66 . 1)))
7.      (progn
8.        (vlax-for obj
9.              (vla-get-activeselectionset
10.                (vla-get-activedocument (vlax-get-acad-object))
11.              )
12.          (setq blk
13.             (cons (list (vlax-get obj 'Insertionpoint) obj) blk)
14.          )
15.        )
16.        (setq blk (vl-sort blk
17.                   '(lambda (x1 x2)
18.                  (if (equal (caar x1) (caar x2) 1e-8)
19.                    (> (cadar x1) (cadar x2))
20. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; (< (caar x1) (caar x2))
21. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160; )
22. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; )
23. &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160; )
24. &#160;&#160; &#160;&#160;&#160; )
25. &#160;&#160; &#160;&#160;&#160; (setq num 1)
26. &#160;&#160; &#160;&#160;&#160; (foreach x (mapcar 'cadr blk)
27. &#160;&#160; &#160;&#160;&#160;&#160;&#160; (foreach x&#160;&#160; &#160;(vlax-invoke x 'getattributes)
28. &#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (vla-put-textstring x (rtos num 2 0))
29. &#160;&#160; &#160;&#160;&#160;&#160;&#160; )
30. &#160;&#160; &#160;&#160;&#160;&#160;&#160; (setq num (1+ num))
31. &#160;&#160; &#160;&#160;&#160; )
32. &#160;&#160; &#160; )
33. &#160;&#160;&#160;&#160;&#160;&#160; )
34. &#160;&#160;&#160;&#160; )
35. &#160; )
36. &#160; (princ)
37. )

(defun c:tt () &#160; (vl-catch-all-apply &#160;&#160;&#160; '(lambda (/ blk num) &#160;&#160;&#160;&#160;&#160;&#160; (vla-eval (vlax-get-acad-object) "Thisdrawing.Activeselectionset.Delete") &#160;&#160;&#160;&#160;&#160;&#160; (if (ssget '((0 . "insert") (66 . 1))) &#160;&#160; &#160; (progn &#160;&#160; &#160;&#160;&#160; (vlax-for obj &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160; (vla-get-activeselectionset &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (vla-get-activedocument (vlax-get-acad-object)) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160;&#160;&#160; (setq blk &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160; (cons (list (vlax-get obj 'Insertionpoint) obj) blk) &#160;&#160; &#160;&#160;&#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160; (setq blk (vl-sort blk &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160; '(lambda (x1 x2) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160; (if (equal (caar x1) (caar x2) 1e-8) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; (> (cadar x1) (cadar x2)) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; (< (caar x1) (caar x2)) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160; ) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160; (setq num 1) &#160;&#160; &#160;&#160;&#160; (foreach x (mapcar 'cadr blk) &#160;&#160; &#160;&#160;&#160;&#160;&#160; (foreach x&#160;&#160; &#160;(vlax-invoke x 'getattributes) &#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160; (vla-put-textstring x (rtos num 2 0)) &#160;&#160; &#160;&#160;&#160;&#160;&#160; ) &#160;&#160; &#160;&#160;&#160;&#160;&#160; (setq num (1+ num)) &#160;&#160; &#160;&#160;&#160; ) &#160;&#160; &#160; ) &#160;&#160;&#160;&#160;&#160;&#160; ) &#160;&#160;&#160;&#160; ) &#160; ) &#160; (princ) )

dinosaurhxe

试了一下楼上的代码，似乎没有成功……

而且还有好多看不懂，还需要进一步学习。

dinosaurhxe2

又学了近一个月，自己编了一段，请高手们指点。

3. (defun c:sdl (/ ss i ch i2 psb ent ent1 psbys ent2 dlxh)
4.   (setq ss (ssget '((0 . "INSERT") (66 . 1) (2 . "DLBH")))) ;选择块名为DLBH的块
5.   (setq i -1)
6.   (setq ch (getstring "\n输入场号或者排序起始序号<1>"))
7.   (if (or (null ch) (= ch ""))
8.     　
9.     (setq ch "1")
10.   )
11.   (if (= (type (read ch)) 'INT)
12.     (setq ch (1- (read ch)))
13.     (setq i2 0)
14.   ) ;if
15.   (setq psb (list)) ;排序表
16.   (repeat (sslength ss)
17.     (setq ent  (entget (ssname ss (setq i (1+ i))))
18.    ent1 ent
19.     )
20.     (while (/= (get 0 (setq ent1 (entget (entnext (get -1 ent1))))) "SEQEND")
21.       (if (and (= (get 0 ent1) "ATTRIB") (= (get 2 ent1) "DLBH"))
22. (setq psbys (list (car (get 11 ent1)) ent1)) ;排序表元素
23.       ) ;if
24.     ) ;while
25.     (setq psb (cons psbys psb))
26.   ) ;repeat
27.   (setq psb (vl-sort psb (function (lambda (e1 e2) (< (car e1) (car e2))))))
28.   (repeat (length psb)
29.     (setq ent2 (cadar psb))
30.     (if (= (type ch) 'INT)
31.       (setq dlxh (itoa (setq ch (1+ ch)))) ;电缆序号
32.       (progn
33. (setq dlxh (strcat ch "-" (itoa (setq i2 (1+ i2)))))
34. (setq ent2 (subst (cons 41 0.4) (assoc 41 ent2) ent2)) ;改字宽
35.       ) ;progn
36.     ) ;if
37.     (setq ent2 (subst (cons 1 dlxh) (assoc 1 ent2) ent2))
38.     (entmod ent2)
39.     (setq psb (cdr psb))
40.   ) ;repeat
41. )
42. (defun get (aaaaa bbbbb /)
43.   (cdr (assoc aaaaa bbbbb))
44. )

(defun c:sdl (/ ss i ch i2 psb ent ent1 psbys ent2 dlxh)   (setq ss (ssget '((0 . "INSERT") (66 . 1) (2 . "DLBH")))) ;选择块名为DLBH的块   (setq i -1)   (setq ch (getstring "\n输入场号或者排序起始序号<1>"))   (if (or (null ch) (= ch ""))     　     (setq ch "1")   )   (if (= (type (read ch)) 'INT)     (setq ch (1- (read ch)))     (setq i2 0)   ) ;if   (setq psb (list)) ;排序表   (repeat (sslength ss)     (setq ent  (entget (ssname ss (setq i (1+ i))))    ent1 ent     )     (while (/= (get 0 (setq ent1 (entget (entnext (get -1 ent1))))) "SEQEND")       (if (and (= (get 0 ent1) "ATTRIB") (= (get 2 ent1) "DLBH")) (setq psbys (list (car (get 11 ent1)) ent1)) ;排序表元素       ) ;if     ) ;while     (setq psb (cons psbys psb))   ) ;repeat   (setq psb (vl-sort psb (function (lambda (e1 e2) (< (car e1) (car e2))))))   (repeat (length psb)     (setq ent2 (cadar psb))     (if (= (type ch) 'INT)       (setq dlxh (itoa (setq ch (1+ ch)))) ;电缆序号       (progn (setq dlxh (strcat ch "-" (itoa (setq i2 (1+ i2))))) (setq ent2 (subst (cons 41 0.4) (assoc 41 ent2) ent2)) ;改字宽       ) ;progn     ) ;if     (setq ent2 (subst (cons 1 dlxh) (assoc 1 ent2) ent2))     (entmod ent2)     (setq psb (cdr psb))   ) ;repeat ) (defun get (aaaaa bbbbb /)   (cdr (assoc aaaaa bbbbb)) )

感谢各位前辈的指点，同时感谢hossman@newsmth的提示。

dinosaurhxe2

看得出来，ivde的程序比我的简洁许多，但无奈他的代码中好多我都看不懂，所以就自己只好编一个复杂的了。再请前辈们指点。

秋枫

建议尽量用 vl-sort 函数来排序。其效率比较高，用这个函数后，你不需要考虑排序算法问题。

dinosaurhxe

秋枫大侠能说得详细一些么？我感觉我是用的vl-sort啊？

秋枫

不好意思，刚才没有看清。

dinosaurhxe2

这是我编的第一个排序类的小程序，还多东西其实没有弄懂。用到vl-sort，是因为hossman@newsmth给的提示，至于其他的排序方式，我还有待进一步学习。

感谢各位前辈的指点！

weig168

dinosaurhxe2大侠，你好，请帮忙写一个给块排序的LSP,是冲模零件注解的块，我现在里面的内容全部手动修改的，一套模具2，3百个，真是累啊，请大侠高抬贵手。QQ:279660102