sz721 发表于 2015-7-17 15:27:39

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

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

(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)
    )
)
)

自贡黄明儒 发表于 2015-7-17 15:40:08

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

edata 发表于 2015-7-17 16:02:29

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

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

sz721 发表于 2015-7-17 16:24:13

edata 发表于 2015-7-17 16:02 static/image/common/back.gif
转字符串再转回来。
(atof(rtos 3.0499999999 2 1))
(atof(rtos 3.0511111111 2 1))



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

edata 发表于 2015-7-17 17:09:53

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

sz721 发表于 2015-7-17 17:15:53

edata 发表于 2015-7-17 17:09 static/image/common/back.gif
无码无真相，你是不是前面还用了fix。。。。。

(defun !last (lst)
(reverse (cdr (reverse lst))))
(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 h) "   " (itoa w)))))))
(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))))
(defun make-same-pline-txt-reaction (notifier reactor arg-list)
(make-same-pline-txt notifier (VLR-Data reactor)))
(defun c:jxgl (/ e1 e2 obj1 obj2)
(if (and (setq e1 (car (entsel "\n選択ポリライン：")))
(setq e2 (car (entsel "\n選択関連文字："))))
(progn
(vlax-ldata-put
e1
"Link"
(setq obj2 (vlax-ename->vla-object e2)))
(vlax-ldata-put
e2
"Link"
(setq obj1 (vlax-ename->vla-object e1)))
(setq myReactor
(vlr-object-reactor
(list obj2)
obj1
'((:vlr-modified . make-same-pline-txt-reaction))))
(setq TxtReactor
(vlr-object-reactor
(list obj1)
obj2
'((:vlr-modified . make-same-pline-txt-reaction))))))
(princ))

edata 发表于 2015-7-17 17:43:22

(defun !last (lst)
(reverse (cdr (reverse lst))))
(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(distance p1 p2)
      h(distance p2 p3))
(vl-catch-all-apply
'vla-put-textstring
(list txt
(strcat (rtos h 2 1) "   " (rtos w 2 1)))))))
(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))))
(defun make-same-pline-txt-reaction (notifier reactor arg-list)
(make-same-pline-txt notifier (VLR-Data reactor)))
(defun c:jxgl (/ e1 e2 obj1 obj2)
(if (and (setq e1 (car (entsel "\n選択ポリライン：")))
(setq e2 (car (entsel "\n選択関連文字："))))
(progn
(vlax-ldata-put
e1
"Link"
(setq obj2 (vlax-ename->vla-object e2)))
(vlax-ldata-put
e2
"Link"
(setq obj1 (vlax-ename->vla-object e1)))
(setq myReactor
(vlr-object-reactor
(list obj2)
obj1
'((:vlr-modified . make-same-pline-txt-reaction))))
(setq TxtReactor
(vlr-object-reactor
(list obj1)
obj2
'((:vlr-modified . make-same-pline-txt-reaction))))))
(princ))
页: [1]
查看完整版本: 怎么把整数值改成保留一位小数？