lkm3131 发表于 2017-12-11 12:39:18

请高手给看一下图框编号的程序,按左右上下排列,为什么排序总是不对?

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

lkm3131 发表于 2017-12-11 12:46:30

付费也可以,请高手留下qq

被雨淋湿的鱼℡ 发表于 2018-5-8 08:37:22

不会用啊这程序
页: [1]
查看完整版本: 请高手给看一下图框编号的程序,按左右上下排列,为什么排序总是不对?