Lisp 编程完成英制转换为公制

mouse-net

有没有编程高手帮我编个LISP程序。我做在标注模板图的时候，用英制标注，而加工需要用公制，要是每个都手工改很费时间的。比方说自动标注出的直径为%%C0.125(英寸)，我只能手工改成%%c3.175(0.125x25.4)。能不能编个LISP程序自动改成这样？先谢谢啦！

newdhj

用不到什么程序的，只要在标注样式里设置一下，在标注时就有公英制双尺寸显示了
, L6 w$ W* }1 C& \, x, p你这个“C0.125(英寸)，”也有错误，一般英制是用分数表示的

[ 本帖最后由 newdhj 于 2008-8-10 19:32 编辑 ]

mouse-net

谢谢newdhj 的答复。
肯恩是我没有所清楚，我是在标注模板坐标时出现这个问题。模板的XY坐标标出来后，跟模板就没有关联性了。换句话说，标出来的就是一对文字，不是尺寸了。所以没有办法从设置里面更改。（这个软件是个外挂）。

0 F5 I- r8 L+ W[ 本帖最后由 mouse-net 于 2008-8-11 13:19 编辑 ]

ysryc99001

我有一个发给大家学习学习(defun c:inm()
(setq kkdat(findfile(strcat way"\\dat\\TAGMARK.kdat" )))
  W8 l$ i2 ~; E7 a! u(Setq ss@SS(ssget(list(cons -3 (list(list "my_tag"))))))
7 b: p) n0 ~0 }6 e(setq ss@len(sslength ss@SS))
. _6 P- b& b: ?9 C- ~' ^: O(setq @k 0)
(while(< @k ss@len)
(xl:GetXData (setq ssn(ssname ss@SS @k)) '("my_tag"))
  (setq  my_tag(car(cdr(cdr(car data_i)))))
(if (/= "org"(cdr my_tag ))(progn
8 {5 ^; {; n1 G/ r- w6 [. V  (setq my_tag(cdr my_tag))
0 g, d9 U' k- q# I$ X* r. R  (setq temptag(substr my_tag (+ 2(vl-string-search  " " my_tag))))
  (setq tagmark(substr temptag 1 (vl-string-search  " " temptag)))
8 E- a7 y0 n* E; O  (setq elss(entget ssn))
2 g1 y8 X! A" O& i( a  A7 |4 N(if(= "CIRCLE"(cdr(assoc 0 elss)))(progn
(setq circen(cdr(assoc 10 elss)));;圆心
(setq Rcir(cdr(assoc 40 elss)));;半径
(setq cirlayer(cdr(assoc 8 elss)));;图层
                                    
  ));;(if(= "CIRCLE"(cdr(assoc 0 elss)))(progn
' v% y, K( G+ H* B) D) G
. k; D7 u# U# t, g' j1 o' Q8 l  
% ?: Y* U1 n0 B2 t# x  D2 X  (findtag tagmark)
  
6 V' W. N) b* D- O$ q1 G3 x0 A4 t  ));;(if my_tag(progn
  (setq @k(+ @k 1))
' s' `) |4 f7 X3 w. _& [& H2 O  );;(while(< @k ss@len)

! v4 Z9 [3 |# U( m0 z  (princ)
# B" Q  B3 Q$ ]: h/ N  );end
: S4 o4 c/ Z8 k

9 c; m+ e, w* F7 Q. |
/ y" }, ]6 p/ Y: y; b1 |
5 t+ h0 W4 S0 X" W+ U, S
2 h8 c/ f% g. Q5 u$ N& X6 w3 [; f

' W: h1 `0 v6 m/ V4 x  \7 j2 F# P
;;功能  
7 i. l- h. |+ Q: e) {% I;;获取附着在AutoCAD对象上的扩展图元数据  
7 c, k2 w" A' [1 Z2 ~# C( K* a;;语法  
;;(ax:GetXData Obj AppID)  
;;参数  
;;obj:图元名
, c2 c, ?( B" L( R;;appid:AutoLISP函数REGAPP注册的应用名,如为("*")则返回全部XDATA，如为("AAA" "ACAD")则返回两个程序的数据
;;返回值  
;;返回附着到对象上的扩展图元数据列表  
;;如：  (("south" (1000 . "204201") (1040 . 1.0))
;;       ("AAAA" (1041 . 562.307)  (1000 . "aaaaa"))
;;       ("BBBB" (1000 . "bbbbbbb"))
;;       ("CCCC" (1041 . 752.569))
9 c) [2 ^5 o% V2 x9 [;;      )
3 e, s+ `8 `( Z+ @) O;;样例  
6 f/ l0 t: A, [0 w& V: _1 B5 w;;(xl:GetXData myVlaObj '("*")) 或 (xl:GetXData myVlaObj '("AAA" "ACAD" "my_tag"))
(defun xl:GetXData
" f7 m3 Y- e4 g" ^. Q/ D7 g1 _       (Obj AppID / data n i  k i_k data_k temp1 temp2)
  (setq data_i nil)
$ E2 M  X$ I: r2 W  (setq data (cdr (assoc -3 (entget obj appid)))
/ `* w5 W7 _8 X  G n    (length data)
- e' L5 m0 M$ R i    0
  )
  (repeat n
8 F& ~; L$ L* @) n( |8 ?" v7 x    (setq temp1  (nth i data)
   data_k (list (car temp1))
! S+ ?  H6 e* a* \* h& S9 w   temp1  (cdr temp1)
   k  (length temp1)
1 d$ M+ m" E8 I% k/ D$ W, w   i_k  0
    )
7 A6 B" H8 {3 Y. \    (repeat k
      (setq temp2 (nth i_k temp1)
     i_k   (1+ i_k)
      )
      (if (and (not (equal temp2 '(1002 . "{")))
        (not (equal temp2 '(1002 . "}")))
   )
(setq data_k (append data_k (list temp2)))
      )
: w& j  _' E7 N, j  u9 i& N. ?' j' |    )
    (setq data_i (append data_i (list data_k))
" j% A$ @) O0 W/ }( E$ L1 Y% a   i  (1+ i)
    )
  )
  data_i
)
% p+ b8 e* k1 C/ _. B% s


5 ^4 Y" k/ h( j' _
(defun findtag (tagmark)
- v0 m: B$ P% o$ ?) P  H+ b, t  (setq kdat(open kkdat "r"))
(while(setq kdatread (read-line kdat))
   (if(/=" "(substr kdatread 1 1))
2 O" t- c6 j2 U8 v" q    (if(= kdatread tagmark)(progn
(setq kai nil)                             
0 c+ Y3 Q8 x: b+ m$ ?9 O(while (and (/= kai 1)(setq kdatread (read-line kdat))) ;运行下面的
   (if(/=" "(substr  kdatread 1 1))(setq kai 1))
) T8 o% W0 A8 D/ K2 c3 k7 v  (setq kdatread(substr kdatread 2 ))
  (Setq pwk(vl-string-search " " kdatread))
  (setq comma (strcase (substr  kdatread 1 pwk)));变大写
& U. M$ H# P9 }5 k7 }# Q- E& L  (if (= comma "TEST")(progn
(setq kdatread(substr kdatread (+ pwk 2)))
$ Y$ H7 |0 ?0 i. Y5 q9 L(Setq pwk(vl-string-search " " kdatread))
  (setq textin (strcase (substr  kdatread 1 pwk)));文字插入点
(if (= textin "CEN")(setq textin  circen));如果为CEN为圆心
( n7 \; D& k8 i1 o6 |  (setq kdatread(substr kdatread (+ pwk 2)))
(Setq pwk(vl-string-search " " kdatread))
+ w9 n/ n: }/ V" [3 H8 n  (setq textt (strcase (substr  kdatread 1 pwk)));文字
, P! R! ~5 X) K. e (setvar "clayer" cirlayer)
(vla-Addtext mspace textt(vlax-3d-point textin)2.5);写文字
. O, E( H/ H1 f        ));(if (= comma "TEST")(progn

  (if (= comma "LINE")(progn
2 t8 f7 |8 T7 G/ w: X- H        (setq kdatread(substr kdatread (+ pwk 2)))
(Setq pwk(vl-string-search " " kdatread))
  (setq lineang (strcase (substr  kdatread 1 pwk)));起点
(setq linep1 (polar circen (angtof lineang)  Rcir));起点
       
  (setq kdatread(substr kdatread (+ pwk 2)))
  ^& |. T8 r# g( l(Setq pwk(vl-string-search " " kdatread))
" @  G6 B" c. t( d  (setq lineang2 (strcase (substr  kdatread 1 pwk)));端点
(setq linep2 (polar circen (angtof lineang2)  Rcir));端点
(setvar "clayer" cirlayer)
* V: U4 o! |( a- E: V* W(vla-Addline mspace (vlax-3d-point linep1)(vlax-3d-point linep2));画线               
" U5 v& |7 B# d1 V# f7 f        ));(if (= comma "LINE")(progn
- T. x! i; n; W- S, y
  (if (= comma "HATCH")(progn

' _- f0 r8 }1 c9 K+ O: M* ]7 n                         
        ));(if (= comma "HATCH")(progn
8 U9 G6 k) E' V, j
    (if (= comma "CIRCLE")(progn
! m: L" h! e! S- j; ~
                         
  ^# z& ^2 e. h) U. G6 e        ));(if (= comma "CIRCLE")(progn
  a6 c7 u2 M* @$ O  
! v6 a  k3 G- r+ I* [# W  
) S' L4 Z9 h+ E  );;;(while (=" "(substr (setq kdatread (read-line kdat)) 1 1))
                             
                             
      ));;(if(= kdatread tagmark)(progn
1 d6 E0 m1 L( x% k: N8 m     );;(if(/=" "(substr kdatread 1 1))
- R* `7 f' S6 J. d  Z; X: R   
    );;;(while(setq kdatread (read-line kdat))
+ d% j4 k; H# W5 x+ Y  
  (close kdat)
  );end