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

mouse-net

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

newdhj

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

9 C- O# J% S7 q[ 本帖最后由 newdhj 于 2008-8-10 19:32 编辑 ]

mouse-net

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

0 R' m/ S% P8 z, W% A- n; a' _! M[ 本帖最后由 mouse-net 于 2008-8-11 13:19 编辑 ]

ysryc99001

我有一个发给大家学习学习(defun c:inm()
  i1 z9 @1 _' d3 K  Q- G2 [$ }: m(setq kkdat(findfile(strcat way"\\dat\\TAGMARK.kdat" )))
(Setq ss@SS(ssget(list(cons -3 (list(list "my_tag"))))))
3 ~+ _# J8 h5 @7 l, M9 _(setq ss@len(sslength ss@SS))
- E) o' o) W/ ~0 \, W- s& Z(setq @k 0)
(while(< @k ss@len)
1 S, P- y" b6 f/ P3 W7 S: j$ O  x! m(xl:GetXData (setq ssn(ssname ss@SS @k)) '("my_tag"))
( g( P& H- u  T3 |  (setq  my_tag(car(cdr(cdr(car data_i)))))
8 E3 }# L+ F4 o! p (if (/= "org"(cdr my_tag ))(progn
  (setq my_tag(cdr my_tag))
* ^2 z$ o8 I5 E# e7 J# D  (setq temptag(substr my_tag (+ 2(vl-string-search  " " my_tag))))
' t5 S5 e- m' U6 O. t, Z7 x% y3 S; x  (setq tagmark(substr temptag 1 (vl-string-search  " " temptag)))
7 i* B- V  v% e1 }1 T  (setq elss(entget ssn))
(if(= "CIRCLE"(cdr(assoc 0 elss)))(progn
% N6 |" f  B$ _4 [( V6 r(setq circen(cdr(assoc 10 elss)));;圆心
+ |1 y6 g8 ~" r" s(setq Rcir(cdr(assoc 40 elss)));;半径
& a7 w( L; a% Y/ X(setq cirlayer(cdr(assoc 8 elss)));;图层
1 g( h5 N4 M0 d                                    
  ));;(if(= "CIRCLE"(cdr(assoc 0 elss)))(progn

& E6 `  W0 I5 M) J4 y  
  (findtag tagmark)
3 _, o0 A. i- u" |- B3 e2 X7 D  
  ));;(if my_tag(progn
% F! i' `0 U, S2 G6 d' t& B  (setq @k(+ @k 1))
- E) q8 }! n$ b/ {8 {  b  );;(while(< @k ss@len)

- }7 X- h6 l6 U. K  (princ)
. s# C; f$ h6 O1 T  );end


4 ?, K" w0 V0 E7 e
: H% u& m1 f* l2 b  K
2 u! `4 d! @6 ?  q$ g5 a

1 b, P4 S1 c7 c$ e/ y/ Y, B6 R

;;功能  
;;获取附着在AutoCAD对象上的扩展图元数据  
;;语法  
;;(ax:GetXData Obj AppID)  
;;参数  
;;obj:图元名
* T9 e5 s! f6 m" k- ~7 f;;appid:AutoLISP函数REGAPP注册的应用名,如为("*")则返回全部XDATA，如为("AAA" "ACAD")则返回两个程序的数据
4 t$ i  [6 Y* u! U% F;;返回值  
;;返回附着到对象上的扩展图元数据列表  
5 g5 t4 t- ~1 t2 ^;;如：  (("south" (1000 . "204201") (1040 . 1.0))
;;       ("AAAA" (1041 . 562.307)  (1000 . "aaaaa"))
;;       ("BBBB" (1000 . "bbbbbbb"))
;;       ("CCCC" (1041 . 752.569))
2 J$ b1 {  @* H;;      )
& _8 g7 @- ?5 r$ d4 n, [$ |;;样例  
;;(xl:GetXData myVlaObj '("*")) 或 (xl:GetXData myVlaObj '("AAA" "ACAD" "my_tag"))
; e6 {% E% m6 j(defun xl:GetXData
  O$ m4 _6 |+ {$ F       (Obj AppID / data n i  k i_k data_k temp1 temp2)
  (setq data_i nil)
: t/ x% X# ^4 e/ V* s+ L  (setq data (cdr (assoc -3 (entget obj appid)))
n    (length data)
i    0
  )
% d5 a6 ?5 S7 ?5 D+ R  (repeat n
* t  p' T* ~: j" o  I( z8 [    (setq temp1  (nth i data)
/ C% u+ P: B& [+ }   data_k (list (car temp1))
   temp1  (cdr temp1)
, [4 [! e  W. n; _6 r0 `   k  (length temp1)
3 |+ r, |- x* y/ n: l) ]   i_k  0
    )
    (repeat k
. |0 \' M  i) d& R4 ]0 n      (setq temp2 (nth i_k temp1)
     i_k   (1+ i_k)
      )
3 @  T  k( f' Z      (if (and (not (equal temp2 '(1002 . "{")))
6 r$ r2 ~, l. h( g, w- [        (not (equal temp2 '(1002 . "}")))
) A# {1 C2 e5 E$ @8 ?1 o/ _. b   )
(setq data_k (append data_k (list temp2)))
* x1 s5 r7 ?$ a. q. C      )
    )
    (setq data_i (append data_i (list data_k))
9 a  ^4 E, P% W, c% `   i  (1+ i)
: i2 F! x2 ^, G% d3 a    )
' h) }% m: d0 E0 t+ U9 t$ {  )
- E; ]$ b' v* u, o5 {' x  data_i
)



. \0 P6 T3 M1 f8 q
(defun findtag (tagmark)
  (setq kdat(open kkdat "r"))
(while(setq kdatread (read-line kdat))
( S( q0 S0 V0 F( Z5 S, I0 S1 Y   (if(/=" "(substr kdatread 1 1))
    (if(= kdatread tagmark)(progn
, K- R1 n9 o$ w4 V9 l(setq kai nil)                             
; t6 B( P. Z; I6 ~0 M(while (and (/= kai 1)(setq kdatread (read-line kdat))) ;运行下面的
   (if(/=" "(substr  kdatread 1 1))(setq kai 1))
  (setq kdatread(substr kdatread 2 ))
: ^$ Z3 z$ V9 A7 w/ Z' n6 h  (Setq pwk(vl-string-search " " kdatread))
  (setq comma (strcase (substr  kdatread 1 pwk)));变大写
6 K+ P) o% ~9 c9 S! ^% h  (if (= comma "TEST")(progn
(setq kdatread(substr kdatread (+ pwk 2)))
$ @* S/ |# b( {* J(Setq pwk(vl-string-search " " kdatread))
  (setq textin (strcase (substr  kdatread 1 pwk)));文字插入点
, N% S, T4 ~' P( Y(if (= textin "CEN")(setq textin  circen));如果为CEN为圆心
4 _2 z' a3 w+ [  (setq kdatread(substr kdatread (+ pwk 2)))
(Setq pwk(vl-string-search " " kdatread))
6 x* j5 ?( u% @, v2 u; R+ S  (setq textt (strcase (substr  kdatread 1 pwk)));文字
(setvar "clayer" cirlayer)
(vla-Addtext mspace textt(vlax-3d-point textin)2.5);写文字
        ));(if (= comma "TEST")(progn
$ H% h% ]2 l) F( }, }+ y
  (if (= comma "LINE")(progn
/ o, P  y5 w" P        (setq kdatread(substr kdatread (+ pwk 2)))
  T6 ^$ o" B8 j* q6 m; F" r3 o(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)))
% z9 @! T* ?8 z6 u1 u% z1 |(Setq pwk(vl-string-search " " kdatread))
1 C: I7 z* o) f. m7 _. ^  q; L# e  (setq lineang2 (strcase (substr  kdatread 1 pwk)));端点
(setq linep2 (polar circen (angtof lineang2)  Rcir));端点
(setvar "clayer" cirlayer)
(vla-Addline mspace (vlax-3d-point linep1)(vlax-3d-point linep2));画线               
        ));(if (= comma "LINE")(progn
, X# l/ s: \6 u$ A' m
* i* @6 V0 ]0 E" N  c  (if (= comma "HATCH")(progn
, M! D2 t; {2 b" \& {! m! ~/ d
                         
        ));(if (= comma "HATCH")(progn
. b# B  z. `# D9 A
    (if (= comma "CIRCLE")(progn
8 X$ I6 E6 o. _5 I  }
) D' b* I& F) Z/ o; |4 p$ E. C5 ^                         
        ));(if (= comma "CIRCLE")(progn
  
, m# @  w* a7 g6 X  
( S0 j% E" ]" ~9 p  [$ ~4 v! P3 S  );;;(while (=" "(substr (setq kdatread (read-line kdat)) 1 1))
                             
( Z6 I; M- N! e% h$ y                             
8 i# e- J4 w- [$ O1 D; D9 q  g      ));;(if(= kdatread tagmark)(progn
     );;(if(/=" "(substr kdatread 1 1))
) x6 |# g6 ?% F! M1 x  Y6 U   
    );;;(while(setq kdatread (read-line kdat))
) _( C/ r! ]* u, k. K; M, @" h  
1 m1 R% ~6 b3 N& b. o6 p  (close kdat)
9 Q5 ]$ X: b1 s6 J; Q" h  );end