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

mouse-net

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

newdhj

用不到什么程序的，只要在标注样式里设置一下，在标注时就有公英制双尺寸显示了
你这个“C0.125(英寸)，”也有错误，一般英制是用分数表示的

  v- o+ D; U9 ]1 M[ 本帖最后由 newdhj 于 2008-8-10 19:32 编辑 ]

mouse-net

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

[ 本帖最后由 mouse-net 于 2008-8-11 13:19 编辑 ]

ysryc99001

我有一个发给大家学习学习(defun c:inm()
7 q/ j. T2 {2 N- f! D5 C) U(setq kkdat(findfile(strcat way"\\dat\\TAGMARK.kdat" )))
7 N( F$ R0 m) ]* a(Setq ss@SS(ssget(list(cons -3 (list(list "my_tag"))))))
' a3 S- _1 R: F+ P0 Q(setq ss@len(sslength ss@SS))
+ q( I7 O* Z4 \( h(setq @k 0)
! Q0 E; V% t& o/ S8 @1 s: S(while(< @k ss@len)
7 L9 `7 y  @9 }4 j1 E% G0 \(xl:GetXData (setq ssn(ssname ss@SS @k)) '("my_tag"))
$ G. N  C4 T4 l" q$ G$ z3 g  (setq  my_tag(car(cdr(cdr(car data_i)))))
(if (/= "org"(cdr my_tag ))(progn
& q+ w+ p; X  R7 z- e3 _: G+ n  (setq my_tag(cdr my_tag))
  (setq temptag(substr my_tag (+ 2(vl-string-search  " " my_tag))))
  (setq tagmark(substr temptag 1 (vl-string-search  " " temptag)))
4 @8 [4 d' a9 p+ X# N8 ^- ~  (setq elss(entget ssn))
(if(= "CIRCLE"(cdr(assoc 0 elss)))(progn
(setq circen(cdr(assoc 10 elss)));;圆心
' D4 U5 J- x2 H. l/ L+ k(setq Rcir(cdr(assoc 40 elss)));;半径
(setq cirlayer(cdr(assoc 8 elss)));;图层
, }1 q2 Y4 t7 E# T                                    
& i1 m8 g* f% C  ));;(if(= "CIRCLE"(cdr(assoc 0 elss)))(progn
  h: B$ g/ K; |! l
$ o  Z3 N& E+ }6 r) a6 I9 v5 B- X  
  (findtag tagmark)
  
) ^8 |- u8 N3 d% B5 e$ p  ));;(if my_tag(progn
  (setq @k(+ @k 1))
  );;(while(< @k ss@len)

  (princ)
/ {5 O+ a# ?' K: I+ R, T  );end




/ ^9 n0 E9 j- n. h) M2 O
8 h: U5 V( E8 X3 @0 U' `& Q8 d
; w, _) P3 A1 _2 x4 Y+ G
$ B! r- t" t4 F; C; |
;;功能  
8 j, M" }# s. @& g( D' f5 d;;获取附着在AutoCAD对象上的扩展图元数据  
;;语法  
0 t7 t0 J9 @# z  w0 h;;(ax:GetXData Obj AppID)  
;;参数  
* S% l! B2 J+ M( c( t0 h: r# L( M;;obj:图元名
;;appid:AutoLISP函数REGAPP注册的应用名,如为("*")则返回全部XDATA，如为("AAA" "ACAD")则返回两个程序的数据
;;返回值  
;;返回附着到对象上的扩展图元数据列表  
;;如：  (("south" (1000 . "204201") (1040 . 1.0))
. l4 R$ E% ~1 v# R9 a# T8 K, j1 `7 g;;       ("AAAA" (1041 . 562.307)  (1000 . "aaaaa"))
; F: E) _! t' l' B, P6 M) c;;       ("BBBB" (1000 . "bbbbbbb"))
9 T6 G0 p0 r) W- V4 Y( s;;       ("CCCC" (1041 . 752.569))
6 _6 L7 K& `4 I* `* O;;      )
;;样例  
;;(xl:GetXData myVlaObj '("*")) 或 (xl:GetXData myVlaObj '("AAA" "ACAD" "my_tag"))
(defun xl:GetXData
1 W" @3 p; l0 L4 k       (Obj AppID / data n i  k i_k data_k temp1 temp2)
  (setq data_i nil)
: X$ }# G' M, T: ^" c* v" a  (setq data (cdr (assoc -3 (entget obj appid)))
8 e+ J7 S5 I4 \1 V n    (length data)
) A! W- [3 h4 b8 e+ Q1 G i    0
4 _, b- J  C" }; Q" b# a: V  )
6 U0 I9 l8 k) E* R, y  (repeat n
    (setq temp1  (nth i data)
* ]) k% L4 V$ D9 l- A- ]6 e   data_k (list (car temp1))
" K1 t/ l5 b, T3 J6 W" x   temp1  (cdr temp1)
& [* u% Y( V4 h. X   k  (length temp1)
7 e8 h/ u% i. h- e! r" c( T* n   i_k  0
! H% h  o9 _8 g; ~9 l9 l' a+ d    )
    (repeat k
      (setq temp2 (nth i_k temp1)
  P3 _* R0 r4 u. R/ t7 v     i_k   (1+ i_k)
      )
      (if (and (not (equal temp2 '(1002 . "{")))
        (not (equal temp2 '(1002 . "}")))
   )
' J, ]( i, L# z2 j3 v" i5 Z (setq data_k (append data_k (list temp2)))
      )
$ F+ e( p1 @# v* @3 T7 ?    )
1 V' Q. f  W* N7 J+ o) F3 l    (setq data_i (append data_i (list data_k))
; @& q) @) }3 [' G! u   i  (1+ i)
    )
  )
6 M9 [2 a+ i, c+ _6 h& H  data_i
: k. R' D* C( G: B" n)


! B& y1 I7 r. |8 ~# }* e
% |: c" d6 x- r0 J2 X, p
(defun findtag (tagmark)
  (setq kdat(open kkdat "r"))
(while(setq kdatread (read-line kdat))
( H! L: g. M  I2 C1 N   (if(/=" "(substr kdatread 1 1))
    (if(= kdatread tagmark)(progn
(setq kai nil)                             
(while (and (/= kai 1)(setq kdatread (read-line kdat))) ;运行下面的
% s% I' ]6 D3 E% c   (if(/=" "(substr  kdatread 1 1))(setq kai 1))
* G( a& f0 J9 e6 t  (setq kdatread(substr kdatread 2 ))
  (Setq pwk(vl-string-search " " kdatread))
: }; `2 V% o4 Z# }: a3 N4 g" e  (setq comma (strcase (substr  kdatread 1 pwk)));变大写
  (if (= comma "TEST")(progn
(setq kdatread(substr kdatread (+ pwk 2)))
7 y  V. U0 I$ @& q2 U" C(Setq pwk(vl-string-search " " kdatread))
  (setq textin (strcase (substr  kdatread 1 pwk)));文字插入点
5 s. i* [5 C9 r8 i! G(if (= textin "CEN")(setq textin  circen));如果为CEN为圆心
0 x* l3 Z6 j- v. q6 Q. {& L  (setq kdatread(substr kdatread (+ pwk 2)))
& y5 |8 A, t) N3 j, |(Setq pwk(vl-string-search " " kdatread))
  (setq textt (strcase (substr  kdatread 1 pwk)));文字
# h  p& V% K% H8 g. Z (setvar "clayer" cirlayer)
8 W# ^" U5 i! o7 \1 X* b8 @8 J(vla-Addtext mspace textt(vlax-3d-point textin)2.5);写文字
        ));(if (= comma "TEST")(progn
2 ?& X7 ~2 ^7 c% o, Q7 _  z
  (if (= comma "LINE")(progn
        (setq kdatread(substr kdatread (+ pwk 2)))
(Setq pwk(vl-string-search " " kdatread))
  (setq lineang (strcase (substr  kdatread 1 pwk)));起点
7 @/ C/ x" i0 |! q9 ~ (setq linep1 (polar circen (angtof lineang)  Rcir));起点
% K# F" }8 a# d" B4 V: T9 C       
  (setq kdatread(substr kdatread (+ pwk 2)))
" Z% |6 x0 }: ~(Setq pwk(vl-string-search " " kdatread))
  (setq lineang2 (strcase (substr  kdatread 1 pwk)));端点
(setq linep2 (polar circen (angtof lineang2)  Rcir));端点
(setvar "clayer" cirlayer)
3 e; r( w3 s8 R- U8 f/ ]" Q$ S/ ^( c(vla-Addline mspace (vlax-3d-point linep1)(vlax-3d-point linep2));画线               
9 G! E; D% A# r& v        ));(if (= comma "LINE")(progn

  (if (= comma "HATCH")(progn
6 h% ?" g( o6 j5 M1 D
- a# a$ Q3 V/ P3 Q( J                         
        ));(if (= comma "HATCH")(progn

    (if (= comma "CIRCLE")(progn
* Q7 O: X! K( X' E
                         
( P; s- U0 D- z2 B" H) ~8 z3 U        ));(if (= comma "CIRCLE")(progn
* v& d" j2 {! Y4 H( {# j$ W  
: [+ a# X0 V% {9 h  p; M+ `  
9 X1 I( T6 l5 m, V  );;;(while (=" "(substr (setq kdatread (read-line kdat)) 1 1))
                             
                             
( C1 d2 O" R3 m" i/ R      ));;(if(= kdatread tagmark)(progn
6 z3 n5 u# m2 I& e     );;(if(/=" "(substr kdatread 1 1))
   
    );;;(while(setq kdatread (read-line kdat))
  
  (close kdat)
  );end