龙大哥，能帮一下忙，看看吗

yxp

程序中视口名列表的返回子程序 views_list，参考了 caoyin 的对象编组名的返回程序，本人在这里对 caoyin 大侠表示衷心感谢。

参见http://bbs.mjtd.com/forum.php?mod=viewthread&tid=67629&replyID=94084&skin=1

图面分块程序已更新，可在群里下载。

;;图面分块程序，对空白块则跳过 by:yxp

(defun c:fk( / p1 p2 wp hp wpxn wpyn pp1 n pp2 asn pp tem)
  (setvar "cmdecho" 0)
  ;;输入分块的参数，共四个数据
  (setq p1 (getpoint "\n 请输入对角线第一点:") p2 (getpoint "\n 请输入对角线第二点:")
        wp (getint "\n 请输入水平分块数:")
        hp (getint "\n 请输入竖向分块数:"))
       
  ;;求出每块的宽度和高度     
  (setq wpxn (abs (/ (- (car  p1) (car  p2)) wp))
        wpyn (abs (/ (- (cadr p1) (cadr p2)) hp)))
 
  ;;计算出左上点     
  (setq pp1 (list (min (car  p1) (car  p2)) (max (cadr p1) (cadr p2))))
       
  ;;生成分块列表，横向为A1,A2,A3... 竖向为A1,B1,C1...
  (setq pp '() asn 65)
  (repeat hp
      (setq n 1 pp2 pp1)
      (repeat wp
         (setq lb (list (strcat (chr asn) (itoa n)) (list pp2 (addxp pp2 wpxn (* -1 wpyn))))
               pp2 (addxp pp2 wpxn 0))  ;;求出每块的对角线坐标
                (delps)(command "select" "c" (addxp (car (cadr lb)) 0.0001 -0.0001)
                (addxp (cadr (cadr lb)) -0.0001 0.0001) "")
  (if (ssget "p") (setq pp (cons lb pp) n (1+ n)))
       )        
      (setq pp1 (addxp pp1 0 (* -1 wpyn))
            asn (1+ asn))
   ) (setq pp (reverse pp))

 ;;绘制分块，写块名，建立视图列表
 (setq n 0) (setvar "osmode" 0)(command "undo" "be")
 (repeat (length pp)  
  (command "text" "j" "mc" (addxp (car (cadr (nth n pp))) (/ wpxn 2) (/ wpyn -2))  (/ wpxn 4) "" (car (nth n pp)) )
  (command "rectang" (car (cadr (nth n pp))) (cadr (cadr (nth n pp)))) 
  (command "view" "w" (car (nth n pp)) (car (cadr (nth n pp))) (cadr (cadr (nth n pp))))
  (setq n (+ n 1))
 )  (command "undo" "e") (princ)
)

(defun addxp(li x y)(list (+ (car li) x) (+ (cadr li) y))) 

(defun delps( / aa)  ;;清除上一个选择集
(command "line" "0,0" "0,1" "")(setq aa (entlast))
(command "select" aa "")(entdel aa)
)