sy100 发表于 2010-8-1 17:17:00

[求助]请高手添加：将计算结果保存至剪贴板

<p><font face="Verdana" color="#0000ff"><strong></strong></font>&nbsp;</p>
<p><font face="Verdana"><strong></strong></font>&nbsp;</p>
<p><font face="Verdana" color="#ff0000" size="4"><strong>下面这段程序由网络收集，感谢原作者！</strong></font></p>
<p><font face="Verdana"></font><strong><font color="#0000ff">&nbsp;</font></strong></p>
<p><font face="Verdana" color="#0000ff"><strong>&nbsp;&nbsp; 请求高手在保持原程序功能不变的情况下添加：“将程序计算结果自动复制到剪贴板，按回车或空格键退出”的功能。谢谢！<br/><font color="#99cc00"></font></strong></font></p>
<p><font face="Verdana" color="#0000ff"><strong><font color="#99cc00"></font></strong></font>&nbsp;</p>
<p><font face="Verdana" color="#000000">(defun c:jxjs (/ p1 p2 dx dy ox jd fx dcl_1)<br/>&nbsp; (command "undo" "be")<br/>&nbsp; (initget 1)<br/>&nbsp; (setq&nbsp;p1 (getpoint "\n请选择两圆弧交点: "))<br/>&nbsp; (initget 1)<br/>&nbsp; (setq&nbsp;p2 (getpoint "\n请选择圆心: "))<br/>　(setq dx (- (car p2) (car p1))<br/>&nbsp;dy (- (cadr p2) (cadr p1))<br/>&nbsp;ox (sqrt (+ (* dx dx) (* dy dy)));;;两点间距离<br/>&nbsp;jd (/ (* (* 2 (- (/ pi 4) (atan ox 25)))180)pi);;;两结构面交线的倾角<br/>&nbsp;fx (- 90 (* (/ (angle p1 p2 )pi)180));;;两结构面交线倾向<br/>&nbsp; )<br/>&nbsp; (if (&lt; fx 0)<br/>&nbsp;&nbsp;&nbsp; (setq fx (+ 360 fx))<br/>&nbsp; )<br/>&nbsp; (setq jd (strcat&nbsp; (rtos fx 2 1)"°∠" (rtos jd 2 1)"°"))<br/>&nbsp; (princ "\n两结构面交线的产状: ")<br/>&nbsp; (princ jd)<br/>&nbsp; <br/>&nbsp; (setq dcl_1 (load_dialog "bg_jllx.dcl"))<br/>&nbsp; (if (not (new_dialog "dcl_bg_cpt" dcl_1))(exit))<br/>&nbsp; (set_tile "text3" jd)<br/>&nbsp; (action_tile "accept" " (done_dialog) ")<br/>&nbsp; (start_dialog)<br/>&nbsp; (unload_dialog dcl_1)</font></p>
<p><font face="Verdana" color="#000000">&nbsp; (command "undo" "e")<br/>&nbsp; (princ)<br/>)<br/></font></p>

sy100 发表于 2010-8-3 09:01:00

自己顶一下。。。

mccad 发表于 2010-8-3 10:20:00

<p>用这个函数改造到VBA用就可以。</p>
<p><font face="Verdana">http://bbs.mjtd.com/forum.php?mod=viewthread&tid=29218</font></p>

gufeng 发表于 2010-8-3 16:58:00



(defun c:jxjs (/ p1 p2 dx dy ox jd fx dcl_1 jdt i)
(vl-load-com)
(defun PutClipText (str / html result)
    (if (= 'STR (type str))
      (progn
(setq html   (vlax-create-object "htmlfile")
       result (vlax-invoke
         (vlax-get (vlax-get html 'ParentWindow)
   'ClipBoardData
         )
         'setData
         "Text"
         str
       )
)
(vlax-release-object html)
str
      )
    )
)
;;;(command "undo" "be")
;;;(initget 1)
(setq jdt "")
(setq i 0)
(while (and (setq p1 (getpoint "\n请选择两圆弧交点:<回车或空格键退出> "))
       (setq p2 (getpoint "\n请选择圆心: "))
)
    (progn
;;;      (initget 1)
      (setq dx (- (car p2) (car p1))
   dy (- (cadr p2) (cadr p1))
   ox (sqrt (+ (* dx dx) (* dy dy)))
;;;两点间距离
   jd (/ (* (* 2 (- (/ pi 4) (atan ox 25))) 180) pi)
;;;两结构面交线的倾角
   fx (- 90 (* (/ (angle p1 p2) pi) 180))
;;;两结构面交线倾向
      )
      (if (< fx 0)
(setq fx (+ 360 fx))
      )
      (setq jd (strcat (rtos fx 2 1) "°∠" (rtos jd 2 1) "°"))
      (setq jdt (strcat jdt jd "\r\n"))
      (princ (strcat "\n两结构面交线的产状: "
       jd
       "   当前记录:"
       (itoa (setq i (1+ i)))
      )
      )
      (PutClipText jdt)
    )
)
;;;(setq dcl_1 (load_dialog "bg_jllx.dcl"))
;;;(if (not (new_dialog "dcl_bg_cpt" dcl_1))
;;;    (exit)
;;;)
;;;(set_tile "text3" jd)
;;;(action_tile "accept" " (done_dialog) ")
;;;(start_dialog)
;;;(unload_dialog dcl_1)
;;;(command "undo" "e")
(princ)
)

sy100 发表于 2010-8-3 19:28:00

完全达到应用要求，衷心感谢给予帮助的好心人！！

qyming 发表于 2014-7-5 13:18:19

好，正需要
页: [1]
查看完整版本: [求助]请高手添加：将计算结果保存至剪贴板