请大师做一个这样的程序。

tangjunasd58

可以多选！！！！！！！！！！！！！！

tangjunasd58

;;;给表根据X Y 给定的表达式进行排序-
;;;oflist :(0 > <)其中第一元素表示以X(0)优先还是以Y(1)优先
;;;第二位为X的排序关系第三位为Y的排序关系
;;;第四位为容差值。
;;;从上到下从左到右，容差为0
;;;实例：(NB_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) (list 0 < <) 0)
;;;返回：((7 9) (1 6) (6 4) (7 3) (2 2) (6 2))
;;;从上到下从左到右，容差为1
;;;实例：(NetBee_px '((6 4)(7 3)(6 2)(7 9)(2 2)(1 6)) (list 1 < >) 1)
;;;返回：((7 9) (1 6) (6 4) (2 2) (6 2) (7 3))
(defun NB_px
             (xyzlist oflist ddd / e1 e2 one oneof two twoof)
  (setq one (car oflist))
  (if (= one 0)
    ;;若以X优先
    (setq one        car ;_X
          two        CADR ;_Y
          oneof        (cadr oflist) ;_X
          twoof        (caddr oflist) ;_y
    ) ;_ 结束setq
    ;;若以Y优先
    (setq one        cadr ;_Y
          two        CAR ;_X
          oneof        (caddr oflist) ;_Y
          twoof        (cadr oflist) ;_X
    ) ;_ 结束setq
  ) ;_ 结束if
  (vl-sort xyzlist
           (function (lambda (e1 e2)
                       (cond
                         (
                          (> (abs (- (one e1) (one e2)))
                             ddd
                          ) ;_ 结束>
                          (oneof (one e1)
                                 (one e2)
                          ) ;_ 结束oneof
                         )
                         (
                          T
                          (twoof
                            (two e1)
                            (two e2)
                          ) ;_ 结束twoof
                         )
                       ) ;_ 结束cond
                     ) ;_ 结束lambda
           ) ;_ 结束function
  ) ;_ 结束vl-sort
) ;_ 结束defun
;;; [功能] 判断 X 是否是图元名
(defun MJ:enP (X)
  (= (type X) 'ENAME)
)
;;; [功能] 将选择集转换为图元列表
;;; [参数] SS---选择集
;;; [返回] 表(图元列表长度 图元列表)
(defun MJ:SS->LIST (SS)
  (vl-remove-if-not
    'MJ:enP
    (mapcar
      'cadr
      (ssnamex SS)
    )
  )
)
(defun x_windows
       (rows colu row1 colu1 pt / pt0 pt1 pt2 pt3 pt4 ww ptt ww)
  (setq pt1 pt)
  (setq ww (/ colu1 colu))                ;数据输入
  (setq pt2 (polar pt1 0 colu1))
  (setq pt3 (polar pt2 (* pi 0.5) row1))
  (setq pt4 (polar pt1 (* pi 0.5) row1))
  (command "pline" pt1 pt2 pt3 pt4 "c")        ;外框线
  (setq        ptt pt4
        pt2 pt4
  )


  (setq pt0 pt)
  (repeat colu
    (setq pt1 (mapcar '+ pt0 '(40 40 0)))
    (setq pt2 (polar pt1 0 (- ww 80)))
    (setq pt3 (polar pt1 (* pi 0.5) (- row1 (* row2 (1- rows)) 80)))
    (setq pt4 (polar pt2 (* pi 0.5) (- row1 (* row2 (1- rows)) 80)))
    (command "pline" pt1 pt2 pt4 pt3 "c")
    (setq pt0 (polar pt0 0 ww))                ;下框内框线
  )
  (repeat (1- rows)
    (setq ptt (polar ptt (/ pi -2) row2))
    (setq pt0 ptt)
    (repeat colu
      (setq pt1 (mapcar '+ pt0 '(40 40 0)))
      (setq pt2 (polar pt1 0 (- ww 80)))
      (setq pt3 (polar pt1 (* pi 0.5) (- row2 80)))
      (setq pt4 (polar pt2 (* pi 0.5) (- row2 80)))
      (command "pline" pt1 pt2 pt4 pt3 "C")
      (setq pt0 (polar pt0 0 ww))        ;上框内框线
    )
  )
)

(defun C:hcc (/ lay os rows colu row1 row2 colu1 ptlist x y ss)
  (setvar "CMDECHO" 0)
  (setq lay (getvar "clayer"))
  (setq os (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (command "color" "bylayer")
  (command "layer" "m" "layer5" "c" "5" "layer5" "")
  (setq rows (getint "\n窗a上下分格数(1不分格)/<或2>: ")) ;
  (if (= rows nil)
    (setq rows 2)
  )
  (setq colu (getint "\n窗扇数<4>: "))
  (if (= colu nil)
    (setq colu 4)
  )
  (if (> rows 1)
    (progn
      (setq row2 (getdist "\n窗上格高度<450>: "))
      (if (= row2 nil)
        (setq row2 450)
      )
    )
    (setq row2 1)
  )
  (princ "选择窗外框线，必须PLINE")
  (setq
    ptlist
     (mapcar
       '(lambda        (y)
          (mapcar
            'cdr
            (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget y))
          )
        )
       (MJ:SS->LIST (setq ss (ssget '((0 . "*POLYLINE")))))
     )
  )
  (SETQ
    PTLIST (MAPCAR '(LAMBDA (X) (NB_px X (list 0 < <) 0)) PTLIST)
  )
  (SETQ        PTLIST (MAPCAR '(LAMBDA        (X)
                          (LIST        (CAR X)
                                (DISTANCE (car x) (cadr x))
                                (DISTANCE (car x) (caddr x))
                          )
                        )
                       PTLIST
               )
  )
  (mapcar '(lambda (x)
             (x_windows rows colu (cadr x) (caddr x) (car x))
           )
          PTLIST
  )
  (command "ERASE" ss "")
  (setvar "OSMODE" os)
  (command "layer" "s" lay "")
  (redraw)
  (princ)
)

tangjunasd58

多的一个线没了，能不能改成把要输入的数用对话框行式的。。。。

夺天工

感谢分享，很方便

bai2000

1993063

这个不错，得研究一下

hehoubin

继续努力::D

love1030312

哈哈~~楼主用的还是周大师的那套软件哈  他不是已经停止更新好久了么~ 现在系统都win10 他的软件支持不了win10呀   我以前也用过~~后来他不更新  放弃了

骑着蜗牛旅行666

这个？？？？？

预知幸福

tangjunasd58 发表于 2013-5-5 22:59
功能如图片

忘了在哪里 50元买了这个功能源码   现在应该好多人都有了