明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1967|回复: 2

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

[复制链接]
发表于 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)
    (setq  page 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 0  sslist-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_sortlist  sslist-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))
    )
  )

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2017-12-11 12:46:30 | 显示全部楼层
付费也可以,请高手留下qq
发表于 2018-5-8 08:37:22 | 显示全部楼层
不会用啊这程序
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-29 08:38 , Processed in 0.189977 second(s), 29 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表