(defun c:bb (/ b b1 b2 b3)
(setq
b(rtos (getvar "cdate") 2 0);当前日期
b1 (fix (atof (substr b 1 4)));年
b2 (fix (atof (substr b 5 2)));月
b3 (fix (atof (substr b 7 2)));日
)
(cond
((= b2 2);2月
(if (= (rem b1 4.0) 0);能整除
(alert (strcat "本月天数29\n剩余天数" (rtos (- 29 b3) 2 0)))
(alert (strcat "本月天数28\n剩余天数" (rtos (- 28 b3) 2 0)))
)
)
((or
(= b2 4);4月
(= b2 6);6月
(= b2 9);9月
(= b2 11);11月
)
(alert (strcat "本月天数30\n剩余天数" (rtos (- 30 b3) 2 0)))
)
(T
(alert (strcat "本月天数31\n剩余天数" (rtos (- 31 b3) 2 0)))
)
)
(princ)
) 1291500406 发表于 2019-7-19 11:16
(defun c:bb ( / b b1 b2 b3 b4)
(setq b(rtos(getvar ' cdate)2 0)b1 (fix(atof(substr b 1 4)))b2(fix ...
;;说明:把字符串按特定字符分隔成表
;;参数:str:字符串
;;参数:del:字符串的分隔符
;;返回:表
;;用法:(T-string-separated "2012-07-01" "-")
(defun T-string-separated (str del / lst pos)
(if (/= str nil)
(progn
(while (setq pos (vl-string-search del str))
(setq
lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 1 (strlen del)))
)
)
(reverse (cons str lst))
)
)
)
;;说明:时间计算
;;参数:time1:时间
;;参数:time2:时间
;;参数:model:+相加-相减
;;参数:get:返回模式 1---字符串时间2---表时间
;;返回:时间表 第1项 -1--退回1天 0--当天 1--前进1天
;; (-1 "23:59:40")
;; (-1 23 59 40)
;;用法:(T-time-calculate "23:50:50" "00:51:10" '+ 1)--->(1 "00:42:00")
(defun T-time-calculate (time1 time2 model get / day h m s)
(setq time1 (mapcar 'atoi (T-string-separated time1 ":")))
(setq time2 (mapcar 'atoi (T-string-separated time2 ":")))
(setq day 0)
(cond
((= model '+)
(if (>= (setq s (+ (nth 2 time1) (nth 2 time2))) 60);大于等于60秒
(progn
(setq m 1);分+1
(setq s (- s 60))
)
);计算秒
(if (if m
(>= (setq m (+ (nth 1 time1) (nth 1 time2) 1)) 60);大于等于60分
(>= (setq m (+ (nth 1 time1) (nth 1 time2))) 60);大于等于60分
)
(progn
(setq h 1);时+1
(setq m (- m 60))
)
);计算分
(if (if h
(>= (setq h (+ (nth 0 time1) (nth 0 time2) 1)) 24);大于等于24时
(>= (setq h (+ (nth 0 time1) (nth 0 time2))) 24);大于等于24时
)
(progn
(setq day 1);天+1
(setq h (- h 24))
)
);计算时
)
((= model '-)
(if (< (setq s (- (nth 2 time1) (nth 2 time2))) 0);小于0秒
(progn
(setq m -1);分-1
(setq s (+ 60 s))
)
);计算秒
(if (if m
(< (setq m (- (nth 1 time1) (nth 1 time2) 1)) 0);小于0分
(< (setq m (- (nth 1 time1) (nth 1 time2))) 0);小于0分
)
(progn
(setq h -1);时-1
(setq m (+ m 60))
)
);计算分
(if (if h
(< (setq h (- (nth 0 time1) (nth 0 time2) 1)) 0);小于0时
(< (setq h (- (nth 0 time1) (nth 0 time2))) 0);小于0时
)
(progn
(setq day -1);时+1
(setq h 23)
)
);计算时
)
)
(cond
((= get 1)
(list day (strcat
(if (= (strlen (setq h (itoa h))) 1)
(strcat "0" h)
h
)
":"
(if (= (strlen (setq m (itoa m))) 1)
(strcat "0" m)
m
)
":"
(if (= (strlen (setq s (itoa s))) 1)
(strcat "0" s)
s
)
)
)
)
((= get 2)
(list day h m s)
)
)
)
;;说明:获取指定年份的总天数
;;参数:year:年
;;返回:当年的天数
(defun T-get-year-days (year)
(if (numberp year)
(if (= 0 (rem year 4))
(if (= 0 (rem year 100))
(if (= 0 (rem year 400))
366
365
)
366
)
365
)
)
)
;;说明:获取指定年份每月天数的关联表
;;参数:year:年
;;返回:每月天数的关联表
(defun T-get-year-every-month-days (year)
(list
(cons 1 31)
(cons 2
(if (= 0 (rem year 4))
(if (= 0 (rem year 100))
(if (= 0 (rem year 400))
29
28
)
29
)
28
)
)
(cons 3 31)
(cons 4 30)
(cons 5 31)
(cons 6 30)
(cons 7 31)
(cons 8 31)
(cons 9 30)
(cons 10 31)
(cons 11 30)
(cons 12 31)
)
)
;;说明:格林时间转北京时间
;;参数:date:格林时间
;;返回:北京时间
;;用法:(T-gmt-Beijing-time "Fri, 19 Jul 2019 05:57:20 GMT")
(defun T-gmt-Beijing-time (date / day month n temp time week years)
(setq date (T-string-separated date " "))
(setq years (atoi (nth 3 date)));年
(setq month (nth 2 date));月
(cond
((= (strcase month) "JAN")
(setq month 1)
)
((= (strcase month) "FEB")
(setq month 2)
)
((= (strcase month) "MAR")
(setq month 3)
)
((= (strcase month) "APR")
(setq month 4)
)
((= (strcase month) "MAY")
(setq month 5)
)
((= (strcase month) "JUN")
(setq month 6)
)
((= (strcase month) "JUL")
(setq month 7)
)
((= (strcase month) "AUG")
(setq month 8)
)
((= (strcase month) "SEP")
(setq month 9)
)
((= (strcase month) "OCT")
(setq month 10)
)
((= (strcase month) "NOW")
(setq month 11)
)
((= (strcase month) "DEC")
(setq month 12)
)
)
(setq day (atoi (nth 1 date)));日
(setq time (nth 4 date));时间
(setq week (vl-list->string (reverse (cdr (reverse (vl-string->list (car date)))))));星期
(cond
((= (strcase week) "MON");星期一
(setq week 0)
)
((= (strcase week) "TUES");星期二
(setq week 1)
)
((= (strcase week) "WED");星期三
(setq week 2)
)
((= (strcase week) "WED");星期四
(setq week 3)
)
((= (strcase week) "FRI");星期五
(setq week 4)
)
((= (strcase week) "SAT");星期六
(setq week 5)
)
((= (strcase week) "THU");星期日
(setq week 6)
)
)
(setq time (T-time-calculate time "08:00:00" '+ 1));北京时间
(if (= (car time) 1)
(progn
(setq temp (cdr (assoc month (T-get-year-every-month-days years))));本月天数
(if (> (setq day (+ day 1)) temp);大于本月天数
(progn
(setq day 1);1号
(setq n 1);加1月
(if (> (1+ week) 6)
(setq week (- (1+ week) 7))
(setq week (1+ week))
);星期
)
)
)
)
(if n
(if (< month 12)
(setq month (1+ month));加1月
(progn
(setq month (- (1+ month) 12));加1月减12月
(setq years (1+ years));加1年
)
)
)
(strcat
(itoa years);年
"-"
(if (= (strlen (setq month (itoa month))) 1)
(strcat "0" month)
month
);月
"-"
(if (= (strlen (setq day (itoa day))) 1)
(strcat "0" day)
day
);日
" "
(cadr time)
" "
(nth week '("星期一" "星期二" "星期三" "星期四" "星期五" "星期六" "星期日"))
)
)
(T-gmt-Beijing-time "Fri, 19 Jul 2019 05:57:20 GMT")--->"2019-07-19 13:57:20 星期五"网上找了一些 自己写了一些 字符串分隔好像是黄大师的写的最菜的那2个就是我自己写的
或许您可参研 Julian.Lsp Andyhon 发表于 2019-7-19 14:20
或许您可参研 Julian.Lsp
http://read.pudn.com/downloads661/sourcecode/app/2682589/lisp%20share/BONUS/CADTOOLS/JULIAN.LSP__.htm
是这个吗?
我这儿在 Express之下
...\Express\julian.Lsp
Andyhon 发表于 2019-7-19 16:27
我这儿在 Express之下
...\Express\julian.Lsp
果然有 CAD安装目录下重来没有去翻过
谢了 本帖最后由 1291500406 于 2022-3-8 10:21 编辑
taoyi0727 发表于 2019-7-19 14:03
网上找了一些 自己写了一些 字符串分隔好像是黄大师的写的最菜的那2个就是我自己写的
---> "2019年7月19日 13:57:20 星期五"
(T-gmt-Beijing-time "Fri, 19 Jul 2019 05:57:20 GMT")--->"2019-07-19 13:57:20 星期五"太复杂了
LISP调用javascript函数方法举例 - AutoLISP/Visual LISP 编程技术 - CAD论坛 - 明经CAD社区 - Powered by Discuz! (mjtd.com)
页:
1
[2]