[分享]：在cad裏畫日曆

taner

[PHP]
;cal.lsp
;James Tunstall
;Autodesk Australia
;28-08-91

;draws calenders of any year
;in several arrangements
;at any scale

;AutoCAD Release 11 or greater is required

;Z direction of the current UCS.
(defun zdir
   (
      / xdir ydir
      a1 a2 a3
      b1 b2 b3
   )

   (setq xdir (getvar "UCSXDIR"))    ;X direction of the current UCS
   (setq ydir (getvar "UCSYDIR"))    ;Y direction of the current UCS

   (setq a1 (car xdir) a2 (cadr xdir) a3 (caddr xdir))
   (setq b1 (car ydir) b2 (cadr ydir) b3 (caddr ydir))

   ;return UCS Z axis direction

   (list
      (- (* a2 b3) (* a3 b2))
      (- (* a3 b1) (* a1 b3))
      (- (* a1 b2) (* a2 b1))
   )
)

;xdir of ECS
;requires (zdir)
(defun xdir
   (
   / normal factor b1 b2 b3 a1 a2 a3
   )

   (setq normal (zdir))
   (setq factor (/ 1.0 64.0))
   (setq b1 (car normal))
   (setq b2 (cadr normal))
   (setq b3 (caddr normal))

   (if
      (and
         (< (abs b1) factor)
         (< (abs b2) factor)
      )
      (progn
         (setq a1 0.0 a2 1.0 a3 0.0)
      )
      (progn
         (setq a1 0.0 a2 0.0 a3 1.0)
      )
   )

   ;return ECS X axis direction

   (list
      (- (* a2 b3) (* a3 b2))
      (- (* a3 b1) (* a1 b3))
      (- (* a1 b2) (* a2 b1))
   )
)


;base angle of UCS in terms of ECS
;requires (xdir) & (zdir)
(defun ucs_base_angle ( / ecs_xdir )

   (setq ecs_xdir
      (mapcar
         (quote +)
         (trans (xdir) 0 1)
         (trans (getvar "UCSORG") 0 1 T)
      )
   )

   (-
      0.0
      (atan (cadr ecs_xdir) (car ecs_xdir))
   )
)


;Modulo division
(defun % (x y)
   (- (fix x) (* (/ (fix x) (fix y)) (fix y)))
)

;Returns T if year is a leap year
(defun LeapYear ( year )
   (cond
      (
         (/= (% year 4) 0)
         nil
      )
      (
         (and
            (= (% year 100) 0)
            (/= (% year 400) 0)
         )
         nil
      )
      (
        T
        T
      )
   )
)

;returns day of week for 1st January for year
(defun JanOne
   ( year
     / LastYear LotsOf400 LotsOf100 LotsOfOne LeapYears DaysAhead
   )
   (if (> year 0)
      (progn
         (setq LastYear (- (fix year) 1))
         (setq LotsOf400 (/ LastYear 400))
         (setq LotsOf100 (/ (% LastYear 400) 100))
         (setq LotsOfOne (% LastYear 100))
         (setq LeapYears
            (+
               (* LotsOf400 97)
               (* LotsOf100 24)
               (/ LotsOfOne 4)
            )
         )
         (setq DaysAhead (+ (fix year) LeapYears))
         ;return day of week for 1st January
         ;0 Sunday 6 Saturday
         (% DaysAhead 7)
      )
      nil
   )
)

;returns a list of 12 calender months
;each month is made up of 5 weeks
;each week is made up of 7 days
;the value of the day indicates the date
;a value of zero(0) indicates a blank
(defun cal
   (
      year
      / week month StartOfMonth DaysInMonth date day calender
   )

   (setq StartOfMonth (JanOne year))

   (setq DaysInMonth
      (if (LeapYear year)
         (list 31 29 31 30 31 30 31 31 30 31 30 31)
         (list 31 28 31 30 31 30 31 31 30 31 30 31)
      )
   )

   (setq calender nil)
   (foreach NoOfDays DaysInMonth
      (setq month nil)
      (setq week nil)
      (cond
         (
            (and (= StartOfMonth 5) (= NoOfDays 31))
            (progn
               (setq week (list 31 0 0 0 0 1 2))
               (setq date 3)
               (setq StartOfMonth 1)
            )
         )
         (
            (and (= StartOfMonth 6) (= NoOfDays 31))
            (progn
               (setq week (list 30 31 0 0 0 0 1))
               (setq date 2)
               (setq StartOfMonth 2)
            )
         )
         (
            (and (= StartOfMonth 6) (= NoOfDays 30))
            (progn
               (setq week (list 30 0 0 0 0 0 1))
               (setq date 2)
               (setq StartOfMonth 1)
            )
         )
         (
            T
            (progn
               (setq day 0)
               (while (< day StartOfMonth)
                  (setq week (append week (list 0)))
                  (setq day (1+ day))
               )
               (setq date 1)
               (while (< day 7)
                  (setq week (append week (list date)))
                  (setq date (1+ date))
                  (setq day (1+ day))
               )
            )
         )
      )

      (setq month (append month (list week)))
      (repeat 4
         (setq week nil)
         (setq day 0)
         (while (< day 7)
            (if (= date NoOfDays)
               (setq StartOfMonth (% (1+ day) 7))
            )
            (if (<= date NoOfDays)
               (setq week (append week (list date)))
               (setq week (append week (list 0)))
            )
            (setq date (1+ date))
            (setq day (1+ day))
         )
         (setq month (append month (list week)))
      )
      (setq calender (append calender (list month)))
   )
)

;draws a box
(defun box (pt0 pt1)
   (command)
   (command
      ".PLINE"
      (list (car pt0) (cadr pt0))
      (list (car pt1) (cadr pt0))
      (list (car pt1) (cadr pt1))
      (list (car pt0) (cadr pt1))
      "C"
   )
)

;draws text
(defun text
   (
      string pt height xscale
      / extdir base_angle
   )

   ;current extrusion direction
   (setq extdir (zdir))

   ;base angle of UCS in terms of ECS
   (setq base_angle (ucs_base_angle))

   (entmake
      (list
         (cons 0 "TEXT")
         (append (list 10) (trans pt 1 extdir))
         (cons 40 height)
         (cons 1 string)
         (cons 50 base_angle)
         (cons 41 xscale)
         (cons 51 0.0)
         (cons 7 (getvar "TEXTSTYLE"))
         (cons 71 0)
         (append (list 210) extdir)
      )
   )
)

;draws a calender month
;given corner points,which month,a list of dates
(defun draw_month
   (
      pt0 pt1 month dates
      / months days xdist ydist m n height width_factor
   )

   (setq months
      (list
         "January"
         "February"
         "March"
         "April"
         "May"
         "June"
         "July"
         "August"
         "September"
         "October"
         "November"
         "December"
      )
   )

   (setq days
      (list
         "Sunday"
         "Monday"
         "Tuesday"
         "Wednesday"
         "Thursday"
         "Friday"
         "Saturday"
      )
   )

   (setq xdist (- (car pt1) (car pt0)))
   (setq ydist (- (cadr pt1) (cadr pt0)))

   (setq height (/ ydist 16.0))
   (setq width_factor (/ xdist ydist 2.0))

   (box pt0 pt1)

   (text
      (nth month months)
      (list
         (+
            (car pt0)
            (/ xdist 2.0)
            (* (strlen (nth month months)) -0.5 height width_factor)
         )
         (+
            (cadr pt0)
            (* 7.0 (/ ydist 8.0))
         )
      )
      height
      width_factor
   )


   (setq m 1.0)
   (foreach day days
      (text
         (strcase (substr day 1 3))
         (list
            (+
               (car pt0)
               (* m (/ xdist 28.0))
            )
            (+
               (cadr pt0)
               (* 6.0 (/ ydist 8.0))
            )
         )
         height
         width_factor
      )
      (setq m (+ m 4.0))
   )


   (setq n 5)
   (foreach week dates
      (setq m 1.0)
      (foreach date week
         (if (/= date 0)
            (text
               (itoa date)
               (list
                  (+
                     (car pt0)
                     (* m (/ xdist 28.0))
                  )
                  (+
                     (cadr pt0)
                     (* n (/ ydist 8.0))
                  )
               )
               height
               width_factor
            )
         )
         (setq m (+ m 4.0))
      )
      (setq n (1- n))
   )
)

;main function
(defun C:cal
   (
      / echo ortho year calender pt0 pt1 pta ptb
      columns rows xdist ydist month i j m n x y option
   )

   ;store system variables
   (setq echo (getvar "CMDECHO"))
   (setq ortho (getvar "ORTHOMODE"))

   ;set system variables
   (setvar "CMDECHO" 0)
   (setvar "ORTHOMODE" 1)

   (command)
   (command ".UNDO" "GROUP")

   ;calender year
   (initget 7)
   (setq year (getint "\nYear :"))

   ;calculate calender for year
   (setq calender (cal year))

   ;get points for lower left month position
   (setq pta (getpoint "\nFirst corner :"))
   (setq ptb (getcorner pta "\nOther corner :"))

   (setq pt0
      (list
         (apply (quote min) (list (car pta) (car ptb)))
         (apply (quote min) (list (cadr pta) (cadr ptb)))
      )
   )

   (setq pt1
      (list
         (apply (quote max) (list (car pta) (car ptb)))
         (apply (quote max) (list (cadr pta) (cadr ptb)))
      )
   )

   (setq xdist (- (car pt1) (car pt0)))
   (setq ydist (- (cadr pt1) (cadr pt0)))

   (initget 7 "All")
   (setq option 13)
   (while (> option 12)
      (setq option (getint "\nWhich month [1-12] / All :"))
      (if (= option "All")
         (setq option 0)
      )
      (if (> option 12)
         (prompt "\nMonth month between [1-12]")
      )
   )

   (if (= option 0)
      (progn
         ;determine calender layout
         (setq columns (getint "\nNumber of columns [1 2 3 4 6 12] :"))
         (while (or (<= columns 0) (/= (% 12 columns) 0))
            (prompt "\nNumber of columns must divide into 12")
            (setq columns (getint "\nNumber of columns [1 2 3 4 6 12] :"))
         )

         (setq rows (/ 12 columns))


         (setq x 0.0)
         (if (/= columns 1)
            (while (< (abs x) xdist)
               (setq x (getdist pt0 "\nDistance between columns ||| :"))
               (if (< (abs x) xdist)
                  (prompt "\nDistance must be > than box width")
               )
            )
         )

         (setq y 0.0)
         (if (/= rows 1)
            (while (< (abs y) ydist)
               (setq y (getdist pt0 "\nDistance between  rows   --- :"))
               (if (< (abs y) ydist)
                  (prompt "\nDistance must be > than box height")
               )
            )
         )

         ;draw calender
         (setq month 0)
         (setq j (1- rows))
         (while (>= j 0)
            (setq n (+ (cadr pt0) (* j y)))
            (setq i 0)
            (while (< i columns)
               (setq m (+ (car pt0) (* i x)))
               (draw_month
                  (list m n)
                  (list
                     (+ m xdist)
                     (+ n ydist)
                  )
                  month
                  (nth month calender)
               )
               (setq i (1+ i))
               (setq month (1+ month))
            )
            (setq j (1- j))
         )
      )
      (progn
         (setq month (1- option))
         (draw_month
            pt0
            pt1
            month
            (nth month calender)
         )
      )
   )

   (command ".UNDO" "END")

   ;restore system variables
   (setvar "CMDECHO" echo)
   (setvar "ORTHOMODE" ortho)


   (princ)
)
[/PHP]

无痕

看来你比较有时间，羡慕阿。。。

丹佛

要对应有农历就好了，＾_＾

它山之石

有点创意。
猜猜看，这是哪年的？

狂刀

是你生日那一年

sincereheart

这个程序不错，有点创意。谢谢楼主。如果能同时显示当前日期和时间就更完美了。

zb_lou

有创意！最好就不用选择，直接将当前系统的时间年月日放到图上，当前的日期变成红色。

cloudwei

楼上说的真是好建议！