求老师们帮改一下两个记忆拉伸的功能

xmq1103

论坛找了关于记忆拉伸的代码，但是都不支持鼠标点取输入，并将点取的距离也可以存入记忆的数值。
就是能不能和自带的拉伸功能一样，然后可以记住上次输入的数值，也能记住鼠标点取的距离数值。


两个记忆拉伸的代码如下：
代码1：
(defun c:jyls (/ s_dis)
(cmdla0)
   (command ".STRETCH" (ssget) "")
   (command (setq BasicPoint (getpoint "\n指定基点:")))
   (if (= nil s_dis_all)
     (progn
       (setq s_dis_all (getreal "\n输入拉伸距离:"))
       (command s_dis_all)
     )
     (progn
       (setq
s_dis (getreal
   (strcat "\n输入拉伸距离<" (rtos s_dis_all 2 4) ">:")
        )
       )
       (if (= nil s_dis)
(setq s_dis s_dis_all)
       )
       (command s_dis)
       (setq s_dis_all s_dis)
  (cmdla1)
     )
   )
)



代码2：

(defun c:s1(/ s_disyd) (setvar "ORTHOMODE" 1) (command ".STRETCH" (ssget) "") (command (setq basicpoint (getpoint "\n指定基点:"))) (if (= nil s_dis_allyd) (progn (setq s_dis_allyd (getreal "\n输入拉伸距离:")) (command s_dis_allyd)) (progn (setq s_disyd (getreal (strcat "\n输入拉伸距离<"(rtos s_dis_allyd 2 4)))) (if (= nil s_disyd) (setq s_disyd s_dis_allyd)) (command s_disyd) (setq s_dis_allyd s_disyd))) (setvar "ORTHOMODE" 0) (princ))

xmq1103

kwok 发表于 2020-7-21 14:19
(defun c:tt (/  dd  pt)
   (command ".STRETCH" (ssget) "")
   (command (setq pt (getpoint "\n指 ...

感谢感谢，非常完美，谢谢了！！

kwok

xmq1103 发表于 2020-7-19 14:57
不行的，试了，不可以呀，老师

(defun c:tt (/  dd  pt)
   (command ".STRETCH" (ssget) "")
   (command (setq pt (getpoint "\n指定基点:")))
(IF (NULL *dd*) (setq *dd* 10))
   (setq dd (getdist pt (strcat "\n输入拉伸距离<" (rtos *dd* 2 2) ">:")))
   (if (NULL dd) (setq dd *dd*) (setq *dd* dd))
  (command dd)
(princ)
)

xmq1103

陈伟 发表于 2020-8-1 11:56
有点问题，按下图选基点拉伸，会出问题！！！，显示的拉伸距离为41977，结果把矩形图框拉成了一条线！！ ...

您用了别人的代码，整合进自己的拉伸工具后，还再单独收币，总感觉让人怪怪的，有问题了再到原作者这里来找解决方案。当然合并代码的时候您确实付出了时间和努力，我能理解，不过还是觉得这么做，不太好吧，如果怕你的工具公开泄露，你可以单独把长老的代码的修改方法的这一段公开就行吧。

kwok

(setq s_dis_all (getreal "\n输入拉伸距离:"))改成 (setq s_dis_all (getdist "\n输入拉伸距离:"))

xmq1103

kwok 发表于 2020-7-19 14:31
(setq s_dis_all (getreal "\n输入拉伸距离:"))改成 (setq s_dis_all (getdist "\n输入拉伸距离:"))

不行的，试了，不可以呀，老师

skyoo

厉害

陈伟

kwok 发表于 2020-7-21 14:19
(defun c:tt (/  dd  pt)
   (command ".STRETCH" (ssget) "")
   (command (setq pt (getpoint "\n指 ...

有点问题，按下图选基点拉伸，会出问题！！！，显示的拉伸距离为41977，结果把矩形图框拉成了一条线！！！

xmq1103

kwok 发表于 2020-7-21 14:19
(defun c:tt (/  dd  pt)
   (command ".STRETCH" (ssget) "")
   (command (setq pt (getpoint "\n指 ...

长老，还真有那个哥们说的问题，专门试才能发现，您的代码还好更新一下吗，最好的话就是，解决了现在的这个问题，再加上个拉伸的时候能直观的预览吗。

kwok

xmq1103 发表于 2020-8-1 16:48
长老，还真有那个哥们说的问题，专门试才能发现，您的代码还好更新一下吗，最好的话就是，解决了现在的这 ...

捕捉关了估计就可以了.试试.