LINE组成的表格单元格操作

分类:lisp函数 | 标签: lisp   表格   单元格   操作  
2008-03-30 14:07 阅读(?)评论(0)

line为表框的表格中单元格操作.lsp


;|思路:
获取表格所有边框 line
指定表格内任一点
根据线条方向,划分两大表 :纵线  横线
分别得到 纵横表 对应的 x y 坐标(每条线只有一个)
根据指定的点位x,在边框 x 表中查找 距点位最近的 正负两线条(如果只有一个,说明点在表外)
根据指定的点位y,在边框 y 表中查找 距点位最近的 正负两线条(如果只有一个,说明点在表外)
|;

(vl-load-com)
;;;====================================
;;;    通用函数  根据点位获取单元格
;;;参数:SS  ----边框对象选择集
;;;      PT  ----指定的点位
;;;使用限制:表格由LINE对象绘制;
;;;          LINE横平竖直;
;;;          单元格无合并现象。
(defun ZML-CELL-POINT (SS PT / LST1 LST2 I ENT PT10 PT11 ANG XMIN XMAX
		       YMIN YMAX)
    ;;根据线条方向,划分两大表 :纵线  横线
    ;;分别得到 纵横表 对应的 x y 坐标(每条线只有一个)
    (setq LST1 '() ;_纵线X坐标表
	  LST2 '() ;_横线Y坐标表
    )
    (setq I 0)
    (repeat (sslength SS)
	(setq ENT  (entget (ssname SS I))
	      PT10 (cdr (assoc 10 ENT))
	      PT11 (cdr (assoc 11 ENT))
	      ANG  (angle PT10 PT11)
	)
	(if (or	(equal ANG (* 0.5 pi) 1e-6)
		(equal ANG (* 1.5 pi) 1e-6)
	    )
	    (setq LST1 (cons (car PT10) LST1))
	)
	(if (or	(equal ANG 0.0 1e-6)
		(equal ANG pi 1e-6)
	    )
	    (setq LST2 (cons (cadr PT10) LST2))
	)
	(setq I (1+ I))
    )
    ;;判断单元格范围
    (if	(and
	    ;;判断是否存在表格
	    (>= (length LST1) 2)
	    (>= (length LST2) 2)
	    ;;判断点是否在表格之内
	    (<= (apply 'min LST1) (car PT) (apply 'max LST1))
	    (<= (apply 'min LST2) (cadr PT) (apply 'max LST2))
	)
	(progn
	    ;;排序
	    (setq LST1 (vl-sort LST1 '<)
		  LST2 (vl-sort LST2 '<)
	    )
	    ;;查找X范围
	    (setq TMP (car LST1))
	    (foreach I (cdr LST1)
		(if (<= TMP (car PT) I)
		    (setq XMIN TMP
			  XMAX I
			  TMP  I
		    )
		    (setq TMP I)
		)
	    )
	    ;;查找Y范围
	    (setq TMP (car LST2))
	    (foreach I (cdr LST2)
		(if (<= TMP (cadr PT) I)
		    (setq YMIN TMP
			  YMAX I
			  TMP  I
		    )
		    (setq TMP I)
		)
	    )
	    ;;返回
	    (list (list XMIN YMIN) (list XMAX YMAX))
	)
    ) ;_结束if
) ;_结束defun
;;;====================================
;;;模式1  复制覆盖
;;;模式2  移动覆盖
;;;模式3  互换
;;;    测试
(defun C:TT1 (/ SS PT)
    (princ "\n选取构成边框的LINE对象...")
    (if (setq SS (ssget '((0 . "LINE"))))
 (while (setq PT (getpoint "\n点取单元格: "))
     (if (and (setq LST1 (ZML-CELL-POINT SS PT))
       (setq PT2 (getpoint PT "\n点取目标单元格: "))
       (setq LST2 (ZML-CELL-POINT SS PT2))
  )
  (progn
      (setq SS1 (ssget "w" (car LST1) (cadr LST1)))
      (setq SS2 (ssget "w" (car LST2) (cadr LST2)))
      ;;删除原有内容
      (if SS2
   (command "_.erase" SS2 "")
      )
      ;;复制
      (if SS1
   (command "_.copy"
     SS1
     ""
     "non"
     (car LST1)
     "non"
     (car LST2)
   )
      )
  )
  (princ "\n==没有对象")
     )
 )
    )
    (princ)
)
;;;========================
(defun C:TT3 (/ SS PT)
    (princ "\n选取构成边框的LINE对象...")
    (if (setq SS (ssget '((0 . "LINE"))))
 (while (setq PT (getpoint "\n点取单元格: "))
     (if (and (setq LST1 (ZML-CELL-POINT SS PT))
       (setq PT2 (getpoint PT "\n点取目标单元格: "))
       (setq LST2 (ZML-CELL-POINT SS PT2))
  )
  (progn
      (setq SS1 (ssget "w" (car LST1) (cadr LST1)))
      (setq SS2 (ssget "w" (car LST2) (cadr LST2)))
      (if SS1
   (command "_.move"
     SS1
     ""
     "non"
     (car LST1)
     "non"
     (car LST2)
   )
      )
      (if SS2
   (command "_.move"
     SS2
     ""
     "non"
     (car LST2)
     "non"
     (car LST1)
   )
      )
  )
  (princ "\n==没有对象")
     )
 )
    )
    (princ)
)
 
  最后修改于 2008-03-30 14:14    阅读(?)评论(0)
 
表  情:
加载中...
 

请各位遵纪守法并注意语言文明