把数字对分程序，坐标点经常错，帮忙看下

lyqiezi

5 r( I* O; N( ^& O1 u

1. (defun c:bdf(/ e ent tc newt mc ang st zb zbx zby zg zb1x zb1y zb2x zb2y zb1 zb2)
   ( j' r$ [$ W( d! S5 q
2.   (setvar "cmdecho" 0)
   * `$ m% [: B* ]/ b  R( T
3.   (setq e (entsel "\n选择要对分的板筋: "))
   4 [' D( G$ I9 X9 V, h8 D1 a8 V
4.   (setq ent (entget (car e)))
   
5.   (setq newt (atoi (cdr (assoc 1 ent))))
   ( _  F9 W# \, B$ W: l+ U1 u1 C
6.   (if (/= 0 newt)                              ;过滤非数值文字
   
7.   (progn
   
8.        (setq tc (cdr (assoc 8 ent)))           ;提取图层信息
   
9.        (command "._Clayer" tc)                 ;保持图层一致
   / {/ t3 S7 z4 ^! {+ K# g
10.        (setq mc (cdr (assoc -1 ent)))          ;提取名称，删除原对象使用
    $ c9 f4 v) G! l0 e
11.        (setq ang (cdr (assoc 50 ent)))         ;提取文字角度
    
12.        (setq st (cdr (assoc 7 ent)))           ;提取文字样式
    
13.        (setq zb (cdr (assoc 10 ent)))          ;提取文字起点坐标
    3 C* J4 K+ L. Z4 A" x. `0 Q, H0 ]
14.        (setq zbx (car zb))                     ;文字x坐标
    
15.        (setq zby (cadr zb))                    ;文字Y坐标
    % H. X2 Z& F" N4 h# d- _
16.        (setq zg (cdr (assoc 40 ent)))          ;提取字高
    8 a* c6 Z% j* T# ?* f$ z
17.        (setq zb1x (+ zbx (* 0.25 newt (cos ang))))  ;计算分开后两个数值的文字起点
    4 X& @4 |$ Y) w( u
18.        (setq zb1y (+ zby (* 0.25 newt (sin ang))))
    
19.        (setq zb2x (- zbx (* 0.25 newt (cos ang))))
    4 F5 z5 |+ O5 f- g. T
20.        (setq zb2y (- zby (* 0.25 newt (sin ang))))
      x8 ]2 O0 X4 E3 t3 Q; Y
21.        (setq zb1 (list zb1x zb1y))                      ;确定坐标点
    0 g2 v3 S9 x, u- j! I3 Q% y
22.        (setq zb2 (list zb2x zb2y))
    
23.        (command "text" "s" st zb1 zg (* 180 (/ ang pi)) (/ newt 2))   ;输入两个对分的数值
    
24.        (command "text" "s" st zb2 zg (* 180 (/ ang pi)) (/ newt 2))
    3 c2 J$ {& r* w4 S4 y. D# s3 ~- i: J
25.        (entdel mc)                                                     ;删除原对象
    ; L+ D# J' ^0 V# L
26.    )
    3 e. w' s& q) I, {. p9 q
27.    (princ "\n所选对象不能处理")
    
28.    )   
    # C2 _2 k( O, K) o3 j( d
29.   (setvar "cmdecho" 1)
    
30.   (princ)
    ' A, o0 s% _/ q8 e
31. )

复制代码

  C( F+ E& [  F* @5 t+ `4 K3 @# r  V
: L/ ~/ |9 L' A( Q8 I1 ?" j第一次照着书写的，程序大部分时间是正常的，但有时候会出现新对象的坐标点不正确，在CAD中进行undo操作发现，大部分的错都是坐标点zb1的问题，就是不知道哪里留下了漏洞

lyqiezi

另外，如果选择的数值字体样式内已经定义高度的时候，程序也会出错，因为这种字体标注时的参数会跳过字高，造成输入错误，这个该如何避开？

woaishuijia

1. (defun c:bdf (/            e          ent        tc    newt  mc          ang        st    zb
   
2.               zbx   zby          zg        zb1x  zb1y  zb2x  zb2y        zb1   zb2
   # `7 Y; v- m+ t& D" g6 e4 R: S8 k
3.               oldosmode
   ( r5 D- O$ \" g. E; n* o
4.              )
   0 h" k7 Z1 R2 K( l- |( i/ @
5.   (setq oldosmode (getvar "osmode"))        ;记录用户当前的对象捕捉设置
   7 Z* [4 ~2 u; c3 b6 h0 N  K
6.   (setvar "osmode" 0)                        ;关闭对象捕捉
   & e! V) P" _" G5 L$ N4 t& k, w* v
7.   (setvar "cmdecho" 0)
   0 U! e3 w0 E% M  V, l
8.   (setq e (entsel "\n选择要对分的板筋: "))
   ! J: s' V( T0 p# ?  c$ Q
9.   (setq ent (entget (car e)))
   6 i5 ]. }" d3 r2 D/ Y4 |/ R9 c
10.   (setq newt (atoi (cdr (assoc 1 ent))))
      [6 O$ j* p0 o2 ^
11.   (if (/= 0 newt)                        ;过滤非数值文字
    2 h$ K1 C% Y! q, J9 Z( P
12.     (progn
    ( v5 x5 b- e7 G6 w# ^
13.       (setq tc (cdr (assoc 8 ent)))        ;提取图层信息
    ) {% g  S, ^! _$ o6 k
14.       (command "._Clayer" tc)                ;保持图层一致
    
15.       (setq mc (cdr (assoc -1 ent)))        ;提取名称，删除原对象使用
    ( P3 {1 x3 X8 [5 U
16.       (setq ang (cdr (assoc 50 ent)))        ;提取文字角度
    ' J  Y$ {- x) J+ T1 q3 ]& |
17.       (setq st (cdr (assoc 7 ent)))        ;提取文字样式
    
18.       (setq zb (cdr (assoc 10 ent)))        ;提取文字起点坐标
    0 W- u5 F$ F% N- a0 |% u
19.       (setq zbx (car zb))                ;文字x坐标
    
20.       (setq zby (cadr zb))                ;文字Y坐标
    # X. f$ t2 i; |
21.       (setq zg (cdr (assoc 40 ent)))        ;提取字高
    
22.       (setq zb1x (+ zbx (* 0.25 newt (cos ang))))
    1 w8 o0 t. Y, ~+ p
23.                                         ;计算分开后两个数值的文字起点
    7 V$ v  _4 L+ T4 C7 F5 j2 R& t2 X+ @
24.       (setq zb1y (+ zby (* 0.25 newt (sin ang))))
    / ^9 _: Z3 T. T, M( }
25.       (setq zb2x (- zbx (* 0.25 newt (cos ang))))
    / j5 X- ?& r% C, K/ o& `
26.       (setq zb2y (- zby (* 0.25 newt (sin ang))))
    2 W( J1 O* q  F5 J* S
27.       (setq zb1 (list zb1x zb1y))        ;确定坐标点
    
28.       (setq zb2 (list zb2x zb2y))
    8 B6 i( U& n7 W* E. m
29.       (if (= (cdr (assoc 40 (entget (tblobjname "style" st)))) 0)
    
30.                                         ;查看该文字样式中文字高度是否为0
    
31.         (progn                                ;文字样式中文字高度为0时使用原对象的文字高度
    9 s) L) L# q$ v. W- H1 z, m9 I
32.           (command "text" "s" st zb1 zg (* 180 (/ ang pi)) (/ newt 2))
    / P1 _" w7 |2 v, o; e$ {5 j
33.                                         ;输入两个对分的数值
    
34.           (command "text" "s" st zb2 zg (* 180 (/ ang pi)) (/ newt 2))
    % c+ D8 M$ ?3 r& }9 g- j+ n' |7 X
35.         )
    ) o& m( C( n4 {$ [; ?/ p7 w& o
36.         (progn                                ;文字样式中文字高度不为0时不在命令行中指定文字高度
    
37.           (command "text" "s" st zb1 (* 180 (/ ang pi)) (/ newt 2))
    
38.                                         ;输入两个对分的数值
    2 U6 h9 X2 q" y
39.           (command "text" "s" st zb2 (* 180 (/ ang pi)) (/ newt 2))
    
40.         )
    " A3 B8 }( V/ S' X) C' |; P
41.       )
    + L' @% @5 F' S( p
42.       (entdel mc)                        ;删除原对象
    
43.     )
    3 E. ?( d  t: G) |) }  L
44.     (princ "\n所选对象不能处理")
    
45.   )
    6 v9 l4 ^' z; C% b2 n- @1 b* }# O
46.   (setvar "osmode" oldosmode)                ;恢复用户对象捕捉设置
    
47.   (setvar "cmdecho" 1)
    4 S2 y: l; g6 ?
48.   (princ)
    
49. )

复制代码

SunVei

Ans1:
(SetVar "OsMode" 0)   ; 加这列 关闭捕捉
  R; P( V5 k2 l$ \
Ans2:
(if (zerop (cdr (assoc 40 (entget (TblobjName "Style" (getvar "TextStyle")))))) ...)

lyqiezi

谢谢上面两位的回答