社区 › Auto Lisp › 表格 源代码

gaomingabc456 发表于 2017-8-4 11:00:00

表格 源代码

(defun c:bg()    ;;;画表格
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq pt1 (getpoint      "\n 第一角点:"))
(setq pt3 (getcorner pt1 "\n 另一角点:"))
(command "rectang" "w" 0 pt1 pt3)
(setq wnn (1+ (getint "\n 列数

linheyuanpcb 发表于 2017-8-6 15:17:00

:")))
(if (null wnn)(setq wnn 5))
(setq hnn (1+ (getint "\n 行数--- :")))
(if (null hnn)(setq hnn 5))
(setq pt2 (list (car pt3) (cadr pt1)))
(setq pt4 (list (car pt1) (cadr pt3)))
(setq ang (angle pt1 pt3))
(cond
    ((and (> ang 0) ( ang (/ pi 2) ) ( ang pi) ( ang (* pi 1.5) ) ( key 1)
      (progn
      (setq txtins (inters ppbas
                           (polar pt1 0 (/ ww wnn))
                           pt1
                           (polar ppbas 0 (/ ww wnn))))
      (command "text" "m" txtins (/ hh hnn 2) 0 (itoa num))
      (setq num (1+ num))
      )
      )
    (setq ppbas      pt1
          key      (1+ key))
    )
(setq      pt1   pp4
      ppbas pp4
      key   1)
(repeat wnn
;;;绘制列
    (setq pt1 (polar pt1 0 (/ ww wnn)))
    (setq pt2 (polar pt1 (* pi 1.5) hh))
    (command "line" pt1 pt2 "")
    (if      (> key 1)
      (progn
      (setq txtins (inters ppbas
                           (polar pt1 (* pi 1.5) (/ hh hnn))
                           pt1
                           (polar ppbas (* pi 1.5) (/ hh hnn))))
      (command "text" "m" txtins (/ hh hnn 2) 0 (chr txt))
      (setq txt (1+ txt))
      )
      )
    (setq ppbas      pt1
          key      (1+ key))
    )
(prin1)
)

jhzxj 发表于 2021-12-26 22:39:00

谢谢分享，支持

qazxswk 发表于 2022-1-30 12:51:00

谢谢，正好试试看

白色微風1991 发表于 2022-7-9 15:08:00

可以，学习一下

白色微風1991 发表于 2022-7-9 15:56:00

可以，學習一下

查看完整版本: 表格 源代码