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

mouse-net

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

newdhj

用不到什么程序的，只要在标注样式里设置一下，在标注时就有公英制双尺寸显示了
你这个“C0.125(英寸)，”也有错误，一般英制是用分数表示的
$ a- @# \, {% a8 M% @' {
[ 本帖最后由 newdhj 于 2008-8-10 19:32 编辑 ]

mouse-net

谢谢newdhj 的答复。
1 @7 q! r( K( M肯恩是我没有所清楚，我是在标注模板坐标时出现这个问题。模板的XY坐标标出来后，跟模板就没有关联性了。换句话说，标出来的就是一对文字，不是尺寸了。所以没有办法从设置里面更改。（这个软件是个外挂）。
& S4 z1 [/ T- N. N1 @
[ 本帖最后由 mouse-net 于 2008-8-11 13:19 编辑 ]

ysryc99001

我有一个发给大家学习学习(defun c:inm()
: h3 k' d4 H& ]# E/ J(setq kkdat(findfile(strcat way"\\dat\\TAGMARK.kdat" )))
9 H$ E$ L' C3 ]" g(Setq ss@SS(ssget(list(cons -3 (list(list "my_tag"))))))
(setq ss@len(sslength ss@SS))
& u8 s2 L5 R# `% [. b(setq @k 0)
! \7 \! y+ f1 n) i6 Q% @3 X  E(while(< @k ss@len)
: Q  v  e9 Y- p/ {8 S(xl:GetXData (setq ssn(ssname ss@SS @k)) '("my_tag"))
- \! ^. [2 [4 }: x  u6 E9 \8 m. l  (setq  my_tag(car(cdr(cdr(car data_i)))))
(if (/= "org"(cdr my_tag ))(progn
% H9 P: I3 U: x) Q! O  (setq my_tag(cdr my_tag))
8 {. o, a5 ?  `) k$ q$ }  (setq temptag(substr my_tag (+ 2(vl-string-search  " " my_tag))))
  (setq tagmark(substr temptag 1 (vl-string-search  " " temptag)))
  (setq elss(entget ssn))
( E+ F- e. v& ^  o(if(= "CIRCLE"(cdr(assoc 0 elss)))(progn
; [! J' U/ I3 i4 y+ o(setq circen(cdr(assoc 10 elss)));;圆心
(setq Rcir(cdr(assoc 40 elss)));;半径
) o+ E" e2 W$ n(setq cirlayer(cdr(assoc 8 elss)));;图层
# Z3 v& [$ J6 x1 l% [" T                                    
  ));;(if(= "CIRCLE"(cdr(assoc 0 elss)))(progn
7 K+ r  W5 }- D7 n0 S- d. e
8 b& ^& `0 ?! r5 G8 j2 M1 @. N  
3 U( X+ o( M" }0 b8 W( R  (findtag tagmark)
7 E5 U% w- {# S4 T  k+ c7 r6 D  
% u1 T) Q( h4 D- B3 G7 R# k; w( w  ));;(if my_tag(progn
  (setq @k(+ @k 1))
  );;(while(< @k ss@len)

  (princ)
  );end


" j5 z( S8 W6 A6 U# d; B
6 X9 j  z* Z* k
2 Q- m5 V, r  s9 n* ~5 _5 i
& m' Z- Z; G" g) H" U


;;功能  
;;获取附着在AutoCAD对象上的扩展图元数据  
;;语法  
;;(ax:GetXData Obj AppID)  
;;参数  
;;obj:图元名
;;appid:AutoLISP函数REGAPP注册的应用名,如为("*")则返回全部XDATA，如为("AAA" "ACAD")则返回两个程序的数据
  \3 U' U5 p. T. a; F1 E;;返回值  
6 V/ ?( Z5 i, [9 }4 h$ B;;返回附着到对象上的扩展图元数据列表  
! I8 |* s" @0 N/ t* V;;如：  (("south" (1000 . "204201") (1040 . 1.0))
7 b, c4 N8 Z' r" x;;       ("AAAA" (1041 . 562.307)  (1000 . "aaaaa"))
. P* g% f. q0 T9 d4 ^; Y;;       ("BBBB" (1000 . "bbbbbbb"))
;;       ("CCCC" (1041 . 752.569))
1 Y9 t/ M( L- d0 h8 h;;      )
;;样例  
7 r  Y, @$ E, L* W( c6 `;;(xl:GetXData myVlaObj '("*")) 或 (xl:GetXData myVlaObj '("AAA" "ACAD" "my_tag"))
- P0 d" I6 R0 [: V! x! X(defun xl:GetXData
       (Obj AppID / data n i  k i_k data_k temp1 temp2)
5 N  R6 n1 Q. u0 |( `+ ^+ d2 l3 R  (setq data_i nil)
  (setq data (cdr (assoc -3 (entget obj appid)))
n    (length data)
i    0
  )
  (repeat n
    (setq temp1  (nth i data)
2 Z2 U& f9 a9 o$ O; Z   data_k (list (car temp1))
   temp1  (cdr temp1)
   k  (length temp1)
   i_k  0
8 I$ u$ u0 C1 \    )
( P6 m  u/ ~- b" B! n7 p    (repeat k
* K9 i/ p! n/ }0 ], P* l      (setq temp2 (nth i_k temp1)
     i_k   (1+ i_k)
      )
      (if (and (not (equal temp2 '(1002 . "{")))
        (not (equal temp2 '(1002 . "}")))
1 }0 J! D/ d+ f& W; L: d6 {   )
% x" v# {7 n$ ? (setq data_k (append data_k (list temp2)))
      )
7 @+ _: H" k% X3 S% g+ r0 p, w    )
) Q( }, W0 t' |: l8 X4 A& |    (setq data_i (append data_i (list data_k))
   i  (1+ i)
2 p% b( p: u1 p* I( W4 ^  p    )
  )
( ^  v2 v  z, H' J' S& u  data_i
)
8 \! M' E. E4 Y8 d# _+ I( ~
' s0 M9 C7 q/ w# k
7 q: y( O/ f: m; ]4 Q

. L( d, w; [3 |9 i9 k# P9 Y(defun findtag (tagmark)
  (setq kdat(open kkdat "r"))
(while(setq kdatread (read-line kdat))
0 e# s( L4 b4 @) i- U  g+ P   (if(/=" "(substr kdatread 1 1))
9 F6 }, c- d. g; U0 W6 z" i& M3 _    (if(= kdatread tagmark)(progn
1 Q3 f; i7 Q; H: ]  P! L% g(setq kai nil)                             
(while (and (/= kai 1)(setq kdatread (read-line kdat))) ;运行下面的
   (if(/=" "(substr  kdatread 1 1))(setq kai 1))
  (setq kdatread(substr kdatread 2 ))
/ p$ c8 y& s. A3 \! g: P  (Setq pwk(vl-string-search " " kdatread))
  (setq comma (strcase (substr  kdatread 1 pwk)));变大写
) h! f( q3 Q1 h& X  ?  (if (= comma "TEST")(progn
% ^. F" u) q# g7 Z- B0 S(setq kdatread(substr kdatread (+ pwk 2)))
" O' ?% b8 m/ [7 h6 Q(Setq pwk(vl-string-search " " kdatread))
  (setq textin (strcase (substr  kdatread 1 pwk)));文字插入点
! _# x0 {- N) B( u- Y: u(if (= textin "CEN")(setq textin  circen));如果为CEN为圆心
  (setq kdatread(substr kdatread (+ pwk 2)))
5 e6 q) O/ ]: |- D(Setq pwk(vl-string-search " " kdatread))
  (setq textt (strcase (substr  kdatread 1 pwk)));文字
(setvar "clayer" cirlayer)
& ?! \( @8 d" {! F(vla-Addtext mspace textt(vlax-3d-point textin)2.5);写文字
        ));(if (= comma "TEST")(progn
5 T: k/ G* D7 E8 m6 [; [: `6 R/ N( F
! T5 ?; k1 n' }) r  (if (= comma "LINE")(progn
6 {7 U5 W* I- r6 R        (setq kdatread(substr kdatread (+ pwk 2)))
(Setq pwk(vl-string-search " " kdatread))
! k9 J9 X8 V$ G+ z& O% ]  (setq lineang (strcase (substr  kdatread 1 pwk)));起点
3 i# D$ j/ P5 `1 ] (setq linep1 (polar circen (angtof lineang)  Rcir));起点
       
% Q2 N9 z- D& N. T  (setq kdatread(substr kdatread (+ pwk 2)))
(Setq pwk(vl-string-search " " kdatread))
& ?2 x7 g4 K/ e4 O  z; P  (setq lineang2 (strcase (substr  kdatread 1 pwk)));端点
4 `5 C" |7 m' e1 X( k" A0 Z(setq linep2 (polar circen (angtof lineang2)  Rcir));端点
(setvar "clayer" cirlayer)
6 Q3 e( |& d; E1 n3 T(vla-Addline mspace (vlax-3d-point linep1)(vlax-3d-point linep2));画线               
        ));(if (= comma "LINE")(progn

  b' Y! f1 I& F! v4 d) N# P& L  (if (= comma "HATCH")(progn

                         
+ z& |/ |& p" R' [- I        ));(if (= comma "HATCH")(progn

    (if (= comma "CIRCLE")(progn

) S' ~' J& Q8 A7 h* Z. f9 u                         
        ));(if (= comma "CIRCLE")(progn
2 }+ W) ^" R7 ~! O. [6 i9 y  
  
  );;;(while (=" "(substr (setq kdatread (read-line kdat)) 1 1))
0 c- u2 K4 t( L7 y4 Q  ]                             
                             
- k- I; v6 i. R" [      ));;(if(= kdatread tagmark)(progn
3 b& L) j3 C  ]& A     );;(if(/=" "(substr kdatread 1 1))
   
) D4 P) f. g6 d: a4 p) g! d    );;;(while(setq kdatread (read-line kdat))
  
  (close kdat)
  );end