请高手给看一下图框编号的程序,按左右上下排列,为什么排序总是不对?
本帖最后由 lkm3131 于 2017-12-11 12:43 编辑(defun c:page()
(setvar "cmdecho" 0)
(vl-load-com)
(setq acadobj(vlax-get-acad-object))
(setq doc(vla-get-activedocument acadobj))
(setq msapce(vla-get-modelspace doc))
(setq page(getint "/n请输入起始页码:"))
(if (= page nil)
(setqpage 1)
)
;;;(setq ss(ssget (list(cons 0 "INSERT"))))
;;;(setq sslen(sslength ss))
(initget "H V S ")(setq GETK (getkword "排序方式:\n [左右上下(H)/左右下上(V)/选择优先(S)]: <H> "))
(princ ">>选择对象...")
(setq ss(ssget (list(cons 0 "INSERT"))))
(setq sslen(sslength ss))
(setq index0 0 index (sslength ss) sslist '())
(repeat index
(setq sslist (cons (ssname ss index0) sslist))
(setq index0 (1+ index0))
)
;开始构建图元点位表
(setq index0 0sslist-ptl '() tmp-pt '())
(repeat index
(setq tmp-pt (cons (nth index0 sslist) (cons (cdr(assoc 10 (entget (nth index0 sslist)))) tmp-pt)))
(setq sslist-ptl (cons tmp-pt sslist-ptl))
(setq tmp-pt '())
(setq index0 (1+ index0))
)
;开始排序
(cond
;从上到下从左到右
((or (= GETK "H")(= GETK nil))
(setq XZ_sortlist (vl-sort
(vl-sort sslist-ptl '(lambda (s1 s2) (> (cadadr s1) (cadadr s2))))
'(lambda (s3 s4) (if(equal (cadadr s3) (cadadr s4) 0.6)(< (caadr s3) (caadr s4))))))
)
;从下到上从左到右
((= GETK "V")
(setq XZ_sortlist(reverse sslist-ptl))
)
;选择顺序
((= GETK "S")
(setq XZ_sortlistsslist-ptl))
);cond
(setq totalpage(itoa sslen))
(setq n 0)
(repeat sslen
(setq m 0)
(setq en(car(nth n XZ_sortlist)))
(setq xobj(vlax-ename->vla-object en))
(setq attpage(vla-getattributes xobj))
(setq svar(vlax-variant-value attpage))
(setq att_list(vlax-safearray->list svar))
(setq len(length att_list))
(repeat len
(setq pageobj(nth m att_list))
(setq tag(vla-get-tagstring pageobj))
(if (= tag "PAGE")
(vla-put-textstring pageobj (strcat "第" (itoa page) "页"))
)
(if(= tag "TOTALPAGE")
(vla-put-textstring pageobj (strcat "共" totalpage "页"))
)
(setq m (1+ m))
)
(setq n(1+ n))
(setq page(1+ page))
)
)
付费也可以,请高手留下qq
不会用啊这程序
页:
[1]