正在加载...
0人已收藏
0人已打赏
0人已点赞
分享
全部回复(2 )
主题
回复
粉丝
CAD下载及教程
52.08 万条内容 · 657 人订阅
阅读下一篇
张工: 您好!上次您到昆明院演示时说最新版的zdm2004解决了负桩号计算问题,但我的同事(商工)在计算时好像还是出现了无法辨明负桩号的情况:会把 0 -10.000认作10.000,试了几次都不行!难道和选用的字型有关吗? 打搅您了!
遇到了一点小问题
内容不能包含下列词语
回帖成功
经验值 +10
全部回复(2 )
只看楼主 我来说两句抢地板回复 举报
;;lisp制表程序
(defun c:hzbg()
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq pt1 (getpoint "\n第一角点: "))
(setq pt3 (getcorner pt1 "\n另一角点: "))
(command "rectang" "w" 1 pt1 pt3)
(setq wnn (1+ (getint "\n栏数 ||| <5>: ")))
(if (null wnn) (setq wnn 5))
(setq hnn (1+ (getint "\n行数 --- <5>: ")))
(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))) (setq pp1 pt1 pp2 pt2 pp3 pt3 pp4 pt4))
((and (> ang (/ pi 2)) (< ang pi)) (setq pp1 pt2 pp2 pt1 pp3 pt4 pp4 pt3))
((and (> ang pi) (< ang (* pi 1.5))) (setq pp1 pt3 pp2 pt4 pp3 pt1 pp4 pt2))
((and (> ang (* pi 1.5)) (< ang (* pi 2))) (setq pp1 pt4 pp2 pt3 pp3 pt2 pp4 pt1))
)
(setq num 1 txt 65)
(setq ww (distance pp1 pp2))
(setq hh (distance pp1 pp4))
(setq pt1 pp4 ppbas pp4 key 1)
(repeat hnn
(setq pt1 (polar pt1 (* pi 1.5) (/ hh hnn)))
(setq pt2 (polar pt1 0 ww))
(command "line" pt1 pt2 "")
(if (> 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)
)
回复 举报