本帖最后由 作者 于 2009-8-24 22:09:02 编辑
请版主帮忙改数字。
下面这个程序是由网上收集，在此感谢原作者！
该程序是用来生成剖面线的。用它生成的剖面线的编号为阿拉伯数字“1、2、3、4、5、6、7、8、9、10、11...”,需要改成罗马数字“Ⅰ Ⅱ Ⅲ Ⅳ Ⅴ Ⅵ Ⅶ Ⅷ Ⅸ Ⅹ...”,其它内容不变。
自己不会弄，特在此敬请版主相助，谢谢！！ 以下为原程序： ;;;
;;; 命令名：BGPMX
;;;
;;; 在平面图中布置剖面线
;;;
;;; 作者：凉开水
;;;
;;; 2005.05.21
;;;
;;;---------------------------------------------------------------------
;;;------画剖面端线及剖面编号子程序------------------
(defun dxbh ()
(progn
(setq a1 (angle pt2 pt1);;;起点方向
pt6 (polar pt1 (+ a1 (/ PI 2)) (* x 3));;;端线第一点
pt7 (polar pt1 (- a1 (/ PI 2)) (* x 3));;;端线第二点
pt8 (polar pt1 a1 (* x 6));;;剖面编号位置
)
(command "pline" pt6 pt7 "");;;画剖面端线
(command "text" "m" pt8 h1 0 n2);;;写剖面编号
(setq a1 (angle pt3 pt4);;;终点方向
pt6 (polar pt4 (+ a1 (/ PI 2)) (* x 3));;;端线第一点
pt7 (polar pt4 (- a1 (/ PI 2)) (* x 3));;;端线第二点
pt8 (polar pt4 a1 (* x 8));;;剖面编号位置
n3 "'"
n3 (strcat n2 n3);;;剖面编号
)
(command "pline" pt6 pt7 "");;;画剖面端线
(command "text" "m" pt8 h1 0 n3);;;写剖面编号
(setq n8 888);;;剖面循环控制
)
)
;;;------画剖面端线及剖面编号子程序----------------
;;;
;;;---------------------------------------------------------------------
(defun c:BGPMX (/ oce1 oce2 oce3 oce4 oce5 x n1 h1 n8 n2 pt1 pt2 pt3 pt4
pt5 pt6 pt7 pt8 a1 n3) ;;;系统变量
(command "undo" "be")
(setq oce1 (getvar "cmdecho");;;保存命令响应原变量值
oce2 (getvar "OSNAPCOORD");;;保存坐标数据优先级原变量值
oce3 (getvar "OSMODE");;;捕捉变量
oce4 (getvar "ANGDIR");;;角度正方向
oce5 (getvar "ANGBASE");;;基准角度
)
(setvar "cmdecho" 0);;;关闭命令响应
(setvar "OSNAPCOORD" 1);;;坐标数据优先级设为：键盘输入替代对象捕捉设置
(setvar "OSMODE" 7095);;;改变捕捉模式
(setvar "ANGDIR" 0);;;角度正方向为逆时针
(setvar "ANGBASE" 0);;;基准角度东方为0
;;;系统变量 (if (= (Tblsearch "style" "BG_ST") nil)
(command "-style" "BG_ST" "宋体" 0 0.8 0 "n" "n");;;文字样式
)
(command "textstyle" "BG_ST")
(If (= (Tblsearch "layer" "剖面") nil)
(command "-layer" "n" "剖面" "c" 1 "剖面" "s" "剖面" "");;;定义图层
)
(command "-layer" "c" 1 "剖面" "s" "剖面" "")
(if (not (setq x (getreal "\n请输入比例<1>: ")))
(setq x 1)
)
(if (not (setq n1 (getint "\n剖面起始号 <1>: ")))
(setq n1 1)
)
(setq h1 (* x 4.5));;;剖面字高
(command "pline" (list 0 0 0) "w" (* x 0.35) (* x 0.35) "");;;定义线宽 ;;;画剖面线------
(setq n8 888)
(while (= n8 888)
(setq n2 (itoa n1))
(if (setq pt1 (getpoint "\n指定起点<退出> : "))
(progn
(command "pline")
(command pt1)
(if (setq pt2 (getpoint pt1 "\n指定下一点<退出> : "))
(progn
(command pt2)
(if (setq pt3 (getpoint pt2 "\n指定下一点 : "))
(progn
(command pt3)
(if (setq pt4 (getpoint pt3 "\n指定下一点 : "))
(progn
(command pt4)
(while (setq pt5 (getpoint pt4 "\n指定下一点 : "))
(command pt5)
(setq pt3 pt4
pt4 pt5
)
)
)
)
)
)
)
)
(command "")
)
)
;;;画剖面线------ ;;;画剖面端线及剖面编号-----
(cond
((= pt1 nil) (setq n8 886));;;无控制点时，结束命令
((= pt2 nil) (setq n8 886));;;一个控制点时，结束命令
((= pt3 nil);;;两个控制点
(progn
(setq pt3 pt1 pt4 pt2)
(dxbh)
)
)
((= pt4 nil);;;三个控制点
(progn
(setq pt4 pt3 pt3 pt2)
(dxbh)
)
)
((= pt5 nil);;;四个及以上控制点
(dxbh)
)
)
(setq n1 (1+ n1));;;下一剖面编号
)
;;;画剖面端线及剖面编号----- ;;;还原系统变量值
(setvar "cmdecho" oce1);;;恢复命令响应
(setvar "OSNAPCOORD" oce2);;;恢复坐标数据优先级设置
(setvar "OSMODE" oce3);;;恢复捕捉模式
(setvar "ANGDIR" oce4);;;恢复角度正方向
(setvar "ANGBASE" oce5);;;恢复基准角度
;;;还原系统变量值 (command "pline" (list 0 0 0) "w" 0 0 "");;;恢复0线宽
(command "undo" "e")
(princ)
)
;;;
;;;-----------------------------------------------------
;;;
| 
发表于 2009-8-23 19:06:00
置顶卡
变色卡
显身卡
楼主