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

lyqiezi

4 ~2 y, d) `- F" w1 n

1. (defun c:bdf(/ e ent tc newt mc ang st zb zbx zby zg zb1x zb1y zb2x zb2y zb1 zb2)
   
2.   (setvar "cmdecho" 0)
   . w9 m4 }; d" E$ q
3.   (setq e (entsel "\n选择要对分的板筋: "))
   8 S7 |* s. f4 K( K6 W$ v
4.   (setq ent (entget (car e)))
   . M, z$ m  D- w# h, I
5.   (setq newt (atoi (cdr (assoc 1 ent))))
   
6.   (if (/= 0 newt)                              ;过滤非数值文字
   # s3 q4 J6 Q8 u
7.   (progn
   
8.        (setq tc (cdr (assoc 8 ent)))           ;提取图层信息
   
9.        (command "._Clayer" tc)                 ;保持图层一致
   ' Z" I, U0 |  r7 \* D0 l( X6 Q
10.        (setq mc (cdr (assoc -1 ent)))          ;提取名称，删除原对象使用
    5 [0 C) P  I- u0 \; E) ]
11.        (setq ang (cdr (assoc 50 ent)))         ;提取文字角度
    
12.        (setq st (cdr (assoc 7 ent)))           ;提取文字样式
    . U; J5 _  O' u, ?8 B1 e
13.        (setq zb (cdr (assoc 10 ent)))          ;提取文字起点坐标
    - b. K# K4 q# |
14.        (setq zbx (car zb))                     ;文字x坐标
    
15.        (setq zby (cadr zb))                    ;文字Y坐标
    
16.        (setq zg (cdr (assoc 40 ent)))          ;提取字高
    
17.        (setq zb1x (+ zbx (* 0.25 newt (cos ang))))  ;计算分开后两个数值的文字起点
    
18.        (setq zb1y (+ zby (* 0.25 newt (sin ang))))
    ) I3 O# _! Q& J0 ~3 _* ^1 G' C! N
19.        (setq zb2x (- zbx (* 0.25 newt (cos ang))))
    . I9 E. d3 u. e/ S
20.        (setq zb2y (- zby (* 0.25 newt (sin ang))))
    
21.        (setq zb1 (list zb1x zb1y))                      ;确定坐标点
    / T- n* H7 V. U( m0 f
22.        (setq zb2 (list zb2x zb2y))
    9 b5 M" D$ Z& r+ Q& @
23.        (command "text" "s" st zb1 zg (* 180 (/ ang pi)) (/ newt 2))   ;输入两个对分的数值
    1 e7 J" b% U$ A
24.        (command "text" "s" st zb2 zg (* 180 (/ ang pi)) (/ newt 2))
    
25.        (entdel mc)                                                     ;删除原对象
    3 B" z& D/ _0 W2 l: v
26.    )
    
27.    (princ "\n所选对象不能处理")
    
28.    )   
    
29.   (setvar "cmdecho" 1)
    ' }; M* a2 `/ p  u
30.   (princ)
    6 X. C+ \& V. K5 [
31. )

复制代码

8 r# |9 `6 x+ h! M. Z
! u) L$ N# B  \+ Q, j% z第一次照着书写的，程序大部分时间是正常的，但有时候会出现新对象的坐标点不正确，在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
   4 E+ t/ V0 n6 i& V' H; J
3.               oldosmode
   , K4 W( O  ~) N( |& U
4.              )
   
5.   (setq oldosmode (getvar "osmode"))        ;记录用户当前的对象捕捉设置
   
6.   (setvar "osmode" 0)                        ;关闭对象捕捉
   0 n9 @+ `' {7 C  X3 Z
7.   (setvar "cmdecho" 0)
   ' v. R; p6 t! B
8.   (setq e (entsel "\n选择要对分的板筋: "))
   ' n1 }4 Q( K" k  O' t  A- u4 w
9.   (setq ent (entget (car e)))
   & F4 {: v) t3 |* k/ _- U" X- ]
10.   (setq newt (atoi (cdr (assoc 1 ent))))
    
11.   (if (/= 0 newt)                        ;过滤非数值文字
    # R7 s3 y! K* V3 t7 o+ V, Q1 @
12.     (progn
    
13.       (setq tc (cdr (assoc 8 ent)))        ;提取图层信息
    2 e9 n4 }& ?9 c; B6 z, W$ ^( Y
14.       (command "._Clayer" tc)                ;保持图层一致
    ; N0 j" ^, ~  t4 q6 ~% e. L
15.       (setq mc (cdr (assoc -1 ent)))        ;提取名称，删除原对象使用
    
16.       (setq ang (cdr (assoc 50 ent)))        ;提取文字角度
    * S" @* K. q& C
17.       (setq st (cdr (assoc 7 ent)))        ;提取文字样式
    % `" a" v4 o) D! ~
18.       (setq zb (cdr (assoc 10 ent)))        ;提取文字起点坐标
    5 w5 Z& ]6 x9 {' U% I( h
19.       (setq zbx (car zb))                ;文字x坐标
    
20.       (setq zby (cadr zb))                ;文字Y坐标
    
21.       (setq zg (cdr (assoc 40 ent)))        ;提取字高
    0 q9 v7 q8 _- k* f+ U. v/ {
22.       (setq zb1x (+ zbx (* 0.25 newt (cos ang))))
    / X3 ~1 L- S: B( C# x) w6 R. u: w: s
23.                                         ;计算分开后两个数值的文字起点
    
24.       (setq zb1y (+ zby (* 0.25 newt (sin ang))))
    
25.       (setq zb2x (- zbx (* 0.25 newt (cos ang))))
    1 Y% ^0 j0 ~, f- S
26.       (setq zb2y (- zby (* 0.25 newt (sin ang))))
    
27.       (setq zb1 (list zb1x zb1y))        ;确定坐标点
    : a) Z' V* a& {: C  u4 m# ~
28.       (setq zb2 (list zb2x zb2y))
    
29.       (if (= (cdr (assoc 40 (entget (tblobjname "style" st)))) 0)
    0 h6 N1 I9 O- h- h4 b4 Z5 c* c% x
30.                                         ;查看该文字样式中文字高度是否为0
    
31.         (progn                                ;文字样式中文字高度为0时使用原对象的文字高度
    . S2 K/ H8 H9 {" U" b% e0 w
32.           (command "text" "s" st zb1 zg (* 180 (/ ang pi)) (/ newt 2))
    
33.                                         ;输入两个对分的数值
    
34.           (command "text" "s" st zb2 zg (* 180 (/ ang pi)) (/ newt 2))
    
35.         )
    % {# c& _. ^  s
36.         (progn                                ;文字样式中文字高度不为0时不在命令行中指定文字高度
    
37.           (command "text" "s" st zb1 (* 180 (/ ang pi)) (/ newt 2))
    
38.                                         ;输入两个对分的数值
    
39.           (command "text" "s" st zb2 (* 180 (/ ang pi)) (/ newt 2))
    
40.         )
    , n% R2 b3 p6 B8 A5 @
41.       )
    
42.       (entdel mc)                        ;删除原对象
    
43.     )
    & {5 [0 Q: E( L& t% H
44.     (princ "\n所选对象不能处理")
    # T& [2 A7 H& F1 N
45.   )
    
46.   (setvar "osmode" oldosmode)                ;恢复用户对象捕捉设置
    8 M% h$ A* O! @
47.   (setvar "cmdecho" 1)
    : t1 \& ^' \" x# j
48.   (princ)
    8 f* M+ Z- Y# ]* j; I
49. )

复制代码

SunVei

Ans1:
* U5 W0 S' r+ g5 {(SetVar "OsMode" 0)   ; 加这列 关闭捕捉
4 c+ }' f/ J8 L3 N/ o; f& e6 g
Ans2:
4 d7 `" v  V% |& _* \(if (zerop (cdr (assoc 40 (entget (TblobjName "Style" (getvar "TextStyle")))))) ...)

lyqiezi

谢谢上面两位的回答