怎么把整数值改成保留一位小数？

sz721

怎么把下列代码取整数值改成保留一位小数？

(defun make-same-pline-txt (obj1 obj2)
  (defun chg_pline_link_txt (v1 / p1 p2 p3 w h txt)
    (setq txt (vlax-ldata-get v1 "Link"))
    (if        (not (vlax-erased-p txt))
      (progn
        (setq p1 (vlax-curve-getpointatparam v1 0.)
              p2 (vlax-curve-getpointatparam v1 1.)
              p3 (vlax-curve-getpointatparam v1 2.)
              w         (fix (distance p1 p2))
              h        (fix (distance p2 p3))
        )
        (vl-catch-all-apply
          'vla-put-textstring
          (list        txt
                (strcat (itoa w) "     " (itoa h))
          )
        )
      )
    )
  )
  (defun chg_txt_link_pline (v1 / sp p1 p2 p3 str pos w h pts)
    (setq pl (vlax-ldata-get v1 "Link"))
    (if        (not (vlax-erased-p pl))
      (progn
        (setq sp  (vlax-curve-getstartpoint pl)
              p1  (vlax-curve-getpointatparam pl 1.)
              p2  (vlax-curve-getpointatparam pl 2.)
              p3  (vlax-curve-getpointatparam pl 3.)
              str (vla-get-textstring v1)
              pos (vl-string-position (ascii "     ") str)
              w          (distof (substr str 1 pos))
              h          (distof (substr str (+ pos 2)))
        )
        (vla-put-coordinates
          pl
          (vlax-make-variant
            (vlax-safearray-fill
              (vlax-make-safearray vlax-vbDouble '(0 . 7))
              (apply 'append
                     (list (!last sp)
                           (setq p11 (polar (!last sp) (angle sp p1) w))
                           (setq p22 (polar p11 (angle p1 p2) h))
                           (polar p22 (angle p2 p3) w)
                     )
              )
            )
          )
        )
        (vla-put-closed pl actrue)
      )
    )
  )
  (if (and
        obj2
        (vlax-write-enabled-p obj2)
        (vlax-read-enabled-p obj1)
      )
    (if        (= (vla-get-objectname obj1) "AcDbText")
      (chg_txt_link_pline obj1)
      (chg_pline_link_txt obj1)
    )
  )
)

自贡黄明儒

(setq w (read (HH:rtosr1 (distance p1 p2) 1));保留一位
http://bbs.mjtd.com/thread-107567-1-1.html

edata

转字符串再转回来。
(atof(rtos 3.0499999999 2 1))
(atof(rtos 3.0511111111 2 1))

1. (atof(rtos(distance p1 p2) 2 1))
   
2. (atof(rtos(distance p2 p3) 2 1))
   

(atof(rtos(distance p1 p2) 2 1))<br /> (atof(rtos(distance p2 p3) 2 1))<br />

sz721

edata 发表于 2015-7-17 16:02
转字符串再转回来。
(atof(rtos 3.0499999999 2 1))
(atof(rtos 3.0511111111 2 1))

原程序代码的效果，用【自贡黄明儒】和 你的方法都不行。

edata

无码无真相，你是不是前面还用了fix。。。。。

sz721

edata 发表于 2015-7-17 17:09
无码无真相，你是不是前面还用了fix。。。。。

2. (defun !last (lst)
   
3. (reverse (cdr (reverse lst))))
   
4. (defun make-same-pline-txt (obj1 obj2)
   
5. (defun chg_pline_link_txt (v1 / p1 p2 p3 w h txt)
   
6. (setq txt (vlax-ldata-get v1 "Link"))
   
7. (if (not (vlax-erased-p txt))
   
8. (progn
   
9. (setq p1 (vlax-curve-getpointatparam v1 0.)
   
10.       p2 (vlax-curve-getpointatparam v1 1.)
    
11.       p3 (vlax-curve-getpointatparam v1 2.)
    
12.       w  (fix (distance p1 p2))
    
13.       h  (fix (distance p2 p3)))
    
14. (vl-catch-all-apply
    
15. 'vla-put-textstring
    
16. (list txt
    
17. (strcat (itoa h) "     " (itoa w)))))))
    
18. (defun chg_txt_link_pline (v1 / sp p1 p2 p3 str pos w h pts)
    
19. (setq pl (vlax-ldata-get v1 "Link"))
    
20. (if (not (vlax-erased-p pl))
    
21. (progn
    
22. (setq sp (vlax-curve-getstartpoint pl)
    
23.       p1 (vlax-curve-getpointatparam pl 1.)
    
24.       p2 (vlax-curve-getpointatparam pl 2.)
    
25.       p3 (vlax-curve-getpointatparam pl 3.)
    
26.      str (vla-get-textstring v1)
    
27.      pos (vl-string-position (ascii "     ") str)
    
28.       w  (distof (substr str 1 pos))
    
29.       h  (distof (substr str (+ pos 2))))
    
30. (vla-put-coordinates
    
31. pl
    
32. (vlax-make-variant
    
33. (vlax-safearray-fill
    
34. (vlax-make-safearray vlax-vbDouble '(0 . 7))
    
35. (apply 'append
    
36. (list (!last sp)
    
37. (setq p11 (polar (!last sp) (angle sp p1) w))
    
38. (setq p22 (polar p11 (angle p1 p2) h))
    
39. (polar p22 (angle p2 p3) w))))))
    
40. (vla-put-closed pl actrue))))
    
41. (if (and
    
42. obj2
    
43. (vlax-write-enabled-p obj2)
    
44. (vlax-read-enabled-p obj1))
    
45. (if (= (vla-get-objectname obj1) "AcDbText")
    
46. (chg_txt_link_pline obj1)
    
47. (chg_pline_link_txt obj1))))
    
48. (defun make-same-pline-txt-reaction (notifier reactor arg-list)
    
49. (make-same-pline-txt notifier (VLR-Data reactor)))
    
50. (defun c:jxgl (/ e1 e2 obj1 obj2)
    
51. (if (and (setq e1 (car (entsel "\n選択ポリライン：")))
    
52. (setq e2 (car (entsel "\n選択関連文字："))))
    
53. (progn
    
54. (vlax-ldata-put
    
55. e1
    
56. "Link"
    
57. (setq obj2 (vlax-ename->vla-object e2)))
    
58. (vlax-ldata-put
    
59. e2
    
60. "Link"
    
61. (setq obj1 (vlax-ename->vla-object e1)))
    
62. (setq myReactor
    
63. (vlr-object-reactor
    
64. (list obj2)
    
65. obj1
    
66. '((:vlr-modified . make-same-pline-txt-reaction))))
    
67. (setq TxtReactor
    
68. (vlr-object-reactor
    
69. (list obj1)
    
70. obj2
    
71. '((:vlr-modified . make-same-pline-txt-reaction))))))
    
72. (princ))
    

(defun !last (lst)<br /> (reverse (cdr (reverse lst))))<br /> (defun make-same-pline-txt (obj1 obj2)<br /> (defun chg_pline_link_txt (v1 / p1 p2 p3 w h txt)<br /> (setq txt (vlax-ldata-get v1 "Link"))<br /> (if (not (vlax-erased-p txt))<br /> (progn<br /> (setq p1 (vlax-curve-getpointatparam v1 0.)<br />       p2 (vlax-curve-getpointatparam v1 1.)<br />       p3 (vlax-curve-getpointatparam v1 2.)<br />       w  (fix (distance p1 p2))<br />       h  (fix (distance p2 p3)))<br /> (vl-catch-all-apply<br /> 'vla-put-textstring<br /> (list txt<br /> (strcat (itoa h) "     " (itoa w)))))))<br /> (defun chg_txt_link_pline (v1 / sp p1 p2 p3 str pos w h pts)<br /> (setq pl (vlax-ldata-get v1 "Link"))<br /> (if (not (vlax-erased-p pl))<br /> (progn<br /> (setq sp (vlax-curve-getstartpoint pl)<br />       p1 (vlax-curve-getpointatparam pl 1.)<br />       p2 (vlax-curve-getpointatparam pl 2.)<br />       p3 (vlax-curve-getpointatparam pl 3.)<br />      str (vla-get-textstring v1)<br />      pos (vl-string-position (ascii "     ") str)<br />       w  (distof (substr str 1 pos))<br />       h  (distof (substr str (+ pos 2))))<br /> (vla-put-coordinates<br /> pl<br /> (vlax-make-variant<br /> (vlax-safearray-fill<br /> (vlax-make-safearray vlax-vbDouble '(0 . 7))<br /> (apply 'append<br /> (list (!last sp)<br /> (setq p11 (polar (!last sp) (angle sp p1) w))<br /> (setq p22 (polar p11 (angle p1 p2) h))<br /> (polar p22 (angle p2 p3) w))))))<br /> (vla-put-closed pl actrue))))<br /> (if (and<br /> obj2<br /> (vlax-write-enabled-p obj2)<br /> (vlax-read-enabled-p obj1))<br /> (if (= (vla-get-objectname obj1) "AcDbText")<br /> (chg_txt_link_pline obj1)<br /> (chg_pline_link_txt obj1))))<br /> (defun make-same-pline-txt-reaction (notifier reactor arg-list)<br /> (make-same-pline-txt notifier (VLR-Data reactor)))<br /> (defun c:jxgl (/ e1 e2 obj1 obj2)<br /> (if (and (setq e1 (car (entsel "\n選択ポリライン：")))<br /> (setq e2 (car (entsel "\n選択関連文字："))))<br /> (progn<br /> (vlax-ldata-put<br /> e1<br /> "Link"<br /> (setq obj2 (vlax-ename->vla-object e2)))<br /> (vlax-ldata-put<br /> e2<br /> "Link"<br /> (setq obj1 (vlax-ename->vla-object e1)))<br /> (setq myReactor<br /> (vlr-object-reactor<br /> (list obj2)<br /> obj1<br /> '((:vlr-modified . make-same-pline-txt-reaction))))<br /> (setq TxtReactor<br /> (vlr-object-reactor<br /> (list obj1)<br /> obj2<br /> '((:vlr-modified . make-same-pline-txt-reaction))))))<br /> (princ))<br />

edata

1. (defun !last (lst)
   
2. (reverse (cdr (reverse lst))))
   
3. (defun make-same-pline-txt (obj1 obj2)
   
4. (defun chg_pline_link_txt (v1 / p1 p2 p3 w h txt)
   
5. (setq txt (vlax-ldata-get v1 "Link"))
   
6. (if (not (vlax-erased-p txt))
   
7. (progn
   
8. (setq p1 (vlax-curve-getpointatparam v1 0.)
   
9.       p2 (vlax-curve-getpointatparam v1 1.)
   
10.       p3 (vlax-curve-getpointatparam v1 2.)
    
11.       w  (distance p1 p2)
    
12.       h  (distance p2 p3))
    
13. (vl-catch-all-apply
    
14. 'vla-put-textstring
    
15. (list txt
    
16. (strcat (rtos h 2 1) "     " (rtos w 2 1)))))))
    
17. (defun chg_txt_link_pline (v1 / sp p1 p2 p3 str pos w h pts)
    
18. (setq pl (vlax-ldata-get v1 "Link"))
    
19. (if (not (vlax-erased-p pl))
    
20. (progn
    
21. (setq sp (vlax-curve-getstartpoint pl)
    
22.       p1 (vlax-curve-getpointatparam pl 1.)
    
23.       p2 (vlax-curve-getpointatparam pl 2.)
    
24.       p3 (vlax-curve-getpointatparam pl 3.)
    
25.      str (vla-get-textstring v1)
    
26.      pos (vl-string-position (ascii "     ") str)
    
27.       w  (distof (substr str 1 pos))
    
28.       h  (distof (substr str (+ pos 2))))
    
29. (vla-put-coordinates
    
30. pl
    
31. (vlax-make-variant
    
32. (vlax-safearray-fill
    
33. (vlax-make-safearray vlax-vbDouble '(0 . 7))
    
34. (apply 'append
    
35. (list (!last sp)
    
36. (setq p11 (polar (!last sp) (angle sp p1) w))
    
37. (setq p22 (polar p11 (angle p1 p2) h))
    
38. (polar p22 (angle p2 p3) w))))))
    
39. (vla-put-closed pl actrue))))
    
40. (if (and
    
41. obj2
    
42. (vlax-write-enabled-p obj2)
    
43. (vlax-read-enabled-p obj1))
    
44. (if (= (vla-get-objectname obj1) "AcDbText")
    
45. (chg_txt_link_pline obj1)
    
46. (chg_pline_link_txt obj1))))
    
47. (defun make-same-pline-txt-reaction (notifier reactor arg-list)
    
48. (make-same-pline-txt notifier (VLR-Data reactor)))
    
49. (defun c:jxgl (/ e1 e2 obj1 obj2)
    
50. (if (and (setq e1 (car (entsel "\n選択ポリライン：")))
    
51. (setq e2 (car (entsel "\n選択関連文字："))))
    
52. (progn
    
53. (vlax-ldata-put
    
54. e1
    
55. "Link"
    
56. (setq obj2 (vlax-ename->vla-object e2)))
    
57. (vlax-ldata-put
    
58. e2
    
59. "Link"
    
60. (setq obj1 (vlax-ename->vla-object e1)))
    
61. (setq myReactor
    
62. (vlr-object-reactor
    
63. (list obj2)
    
64. obj1
    
65. '((:vlr-modified . make-same-pline-txt-reaction))))
    
66. (setq TxtReactor
    
67. (vlr-object-reactor
    
68. (list obj1)
    
69. obj2
    
70. '((:vlr-modified . make-same-pline-txt-reaction))))))
    
71. (princ))

(defun !last (lst)<br /> (reverse (cdr (reverse lst))))<br /> (defun make-same-pline-txt (obj1 obj2)<br /> (defun chg_pline_link_txt (v1 / p1 p2 p3 w h txt)<br /> (setq txt (vlax-ldata-get v1 "Link"))<br /> (if (not (vlax-erased-p txt))<br /> (progn<br /> (setq p1 (vlax-curve-getpointatparam v1 0.)<br />       p2 (vlax-curve-getpointatparam v1 1.)<br />       p3 (vlax-curve-getpointatparam v1 2.)<br />       w  (distance p1 p2)<br />       h  (distance p2 p3))<br /> (vl-catch-all-apply<br /> 'vla-put-textstring<br /> (list txt<br /> (strcat (rtos h 2 1) "     " (rtos w 2 1)))))))<br /> (defun chg_txt_link_pline (v1 / sp p1 p2 p3 str pos w h pts)<br /> (setq pl (vlax-ldata-get v1 "Link"))<br /> (if (not (vlax-erased-p pl))<br /> (progn<br /> (setq sp (vlax-curve-getstartpoint pl)<br />       p1 (vlax-curve-getpointatparam pl 1.)<br />       p2 (vlax-curve-getpointatparam pl 2.)<br />       p3 (vlax-curve-getpointatparam pl 3.)<br />      str (vla-get-textstring v1)<br />      pos (vl-string-position (ascii "     ") str)<br />       w  (distof (substr str 1 pos))<br />       h  (distof (substr str (+ pos 2))))<br /> (vla-put-coordinates<br /> pl<br /> (vlax-make-variant<br /> (vlax-safearray-fill<br /> (vlax-make-safearray vlax-vbDouble '(0 . 7))<br /> (apply 'append<br /> (list (!last sp)<br /> (setq p11 (polar (!last sp) (angle sp p1) w))<br /> (setq p22 (polar p11 (angle p1 p2) h))<br /> (polar p22 (angle p2 p3) w))))))<br /> (vla-put-closed pl actrue))))<br /> (if (and<br /> obj2<br /> (vlax-write-enabled-p obj2)<br /> (vlax-read-enabled-p obj1))<br /> (if (= (vla-get-objectname obj1) "AcDbText")<br /> (chg_txt_link_pline obj1)<br /> (chg_pline_link_txt obj1))))<br /> (defun make-same-pline-txt-reaction (notifier reactor arg-list)<br /> (make-same-pline-txt notifier (VLR-Data reactor)))<br /> (defun c:jxgl (/ e1 e2 obj1 obj2)<br /> (if (and (setq e1 (car (entsel "\n選択ポリライン：")))<br /> (setq e2 (car (entsel "\n選択関連文字："))))<br /> (progn<br /> (vlax-ldata-put<br /> e1<br /> "Link"<br /> (setq obj2 (vlax-ename->vla-object e2)))<br /> (vlax-ldata-put<br /> e2<br /> "Link"<br /> (setq obj1 (vlax-ename->vla-object e1)))<br /> (setq myReactor<br /> (vlr-object-reactor<br /> (list obj2)<br /> obj1<br /> '((:vlr-modified . make-same-pline-txt-reaction))))<br /> (setq TxtReactor<br /> (vlr-object-reactor<br /> (list obj1)<br /> obj2<br /> '((:vlr-modified . make-same-pline-txt-reaction))))))<br /> (princ))