[求助]！！！！！！敬请版主帮忙改数字！！！！！！

xk100 发表于 2009-8-23 19:06:00

本帖最后由作者于 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) ) ;;; ;;;----------------------------------------------------- ;;;

xk100 发表于 2009-8-24 22:08:00

这个程序生成的剖面编号为阿拉伯数字，每次都要改成罗马数字，很不方便，特在此敬请版主给改改，先谢谢了！！！

liminnet 发表于 2009-8-24 22:48:00

贱人发表于 2009-8-25 12:41:00

;功能：数字转换成罗马数字字符串
;条件：字串必须为数字，允许带1位且只带1位后缀
;贱人20090825
(defun c:aa(/ sstxt EndTxt tmp tmp2 tmp3 i Nerr
         nArabicValue nOnes nThousands nFiveHundreds
         nHundreds nFifties nTens nFives
         )
(setvar "CMDECHO" 0)
(setq ss (ssget '((0 . "text"))))
(command "undo" "be")
(if ss(progn
(setq i 0)
(setq Nerr 0)
(repeat (sslength ss)
   (setq txt (cdr (assoc 1 (entget (ssname ss i)))))

   (if (and (= 'INT (type (read txt))) (/= (substr txt (strlen txt)) "'"))
   (progn
      (setq nArabicValue (atoi txt))
      (setq EndTXT "")
   )
   (if (= 'INT (type (read (substr txt 1 (- (strlen txt) 1)))))
      (progn
         (setq nArabicValue (atoi(substr txt 1 (- (strlen txt) 1))))
         (setq EndTXT(substr txt (strlen txt)) )
      )
      (progn
         (setq nArabicValue nil)
         (setq Nerr (+ 1 Nerr))
      )
   )
   )
   (if nArabicValue
   (progn
   (setq
         ;按单位(1000-M,500-D,100-C,50-L,10-X,5-V,1-I)分离
         nOnes nArabicValue
         nThousands (/ nOnes1000)
         nOnes (- nOnes(* nThousands 1000))
         nFiveHundreds (/ nOnes500)
         nOnes (- nOnes(* nFiveHundreds 500))
         nHundreds (/ nOnes100)
         nOnes (- nOnes(* nHundreds 100))
         nFifties (/ nOnes50)
         nOnes (- nOnes(* nFifties 50))
         nTens (/ nOnes10)
         nOnes (- nOnes(* nTens 10))
         nFives (/ nOnes5)
         nOnes (- nOnes(* nFives 5))
   )
   ;先按1千数量生成多个M
   (setq tmp "" tmp2 "" tmp3 "")
   (repeat nThousands
   (setq tmp (strcat tmp "M"))
   )
   ;处理其他单位
   (If (= nHundreds 4)
   ;是4
   (If (= nFiveHundreds 1)
      (setq tmp (strcat tmp "CM"))
      (setq tmp (strcat tmp "CD"))
   )
   ;不是4
   (progn
      (repeat nFiveHundreds
         (setq tmp2 (strcat tmp2 "D"))
      )
      (repeat nHundreds
         (setq tmp3 (strcat tmp3 "C"))
      )
      (setq tmp (strcat tmp tmp2 tmp3))
      (setq tmp2 "" tmp3 "")
   )
   )
   (If (= nTens 4)
   ;是4
   (If (= nFifties 1)
      (setq tmp (strcat tmp "XC"))
      (setq tmp (strcat tmp "XL"))
   )
   ;不是4
   (progn
      (repeat nFifties
         (setq tmp2 (strcat tmp2 "L"))
      )
      (repeat nTens
         (setq tmp3 (strcat tmp3 "X"))
      )
      (setq tmp (strcat tmp tmp2 tmp3))
      (setq tmp2 "" tmp3 "")
   )
   )
   (If (= nOnes 4)
   ;是4
   (If (= nFives 1)
      (setq tmp (strcat tmp "IX"))
      (setq tmp (strcat tmp "IV"))
   )
   ;不是4
   (progn
      (repeat nFives
         (setq tmp2 (strcat tmp2 "V"))
      )
      (repeat nOnes
         (setq tmp3 (strcat tmp3 "I"))
      )
      (setq tmp (strcat tmp tmp2 tmp3 EndTxt))
      (setq tmp2 "" tmp3 "")
   )
   )
   (entmod (subst (cons 1 tmp) (cons 1 (cdr (assoc 1 (entget (ssname ss i))))) (entget (ssname ss i))))
   )
   )
   (setq i (+ 1 i))
)
))
(command "undo" "e")
(if (/= Nerr 0)
(alert (strcat "共选择了 " (itoa (sslength ss)) " 个字串，其中 " (itoa Nerr) " 个字串不符条件,无法修改"))
)
(setvar "CMDECHO" 1)
(princ)
)

liminnet 发表于 2009-8-25 12:48:00

liminnet 发表于 2009-8-25 12:49:00

xk100 发表于 2009-8-25 20:08:00

感谢楼上大侠！上面的程序虽然不能生成我那样的剖面线和剖面编号，但能够将阿拉伯数字改成罗马数字，有异曲同工之妙，收下了，衷心感谢！！

页: [1]

明经CAD社区's Archiver

[求助]！！！！！！ 敬请 版主 帮忙改数字 ！！！！！！

[求助]！！！！！！敬请版主帮忙改数字！！！！！！