你会 stretch (拉伸）吗？

尘缘一生

    CAD拉伸命令不大好用，为此，搜遍本坛，都没有找到一个合适的代码，也许你会说，很多啊，确实，很多，但不符合我这“挑剔”的人，因为我是画图的，不是写代码的

    下面拼凑几句代码，暂时自己用吧，没办法。

     因为本坛高手如云，谁能写个反应器吗？记录键盘的输入，如果有输入，就记录存于变量，即可进一步：实现“记忆距离的拉伸”。

;;;;;;;三领-拉伸;;;;;;框选样式代码;;;;;;;;;;;;;;;;;;;;;;;;
;;:1:可以定点定距离
;;:2:可以任意拉伸;;:3:可以输入距离拉伸
;;;4:和原CAD一样，具有拖曳效果
(defun c:slstrch (/ ss oldorh oldosm basicpoint)
  (vl-cmdf "select" "c" pause)
  (setq ss (ssget "p"))
  (setq oldorh (getvar "ORTHOMODE"))
  (setq oldosm (getvar "OSMODE"))
  (setvar "ORTHOMODE" 1) ;;;正交打开
  (setvar "OSMODE" 16383) ;;;;;对象捕捉 开
  (setq basicpoint (getpoint "\n指定基点(右键任意拉伸)或【输入距离D】:"))
  (if (= nil basicpoint)
    (setq basicpoint (nth 1 (grread 5)))
  )
  (command "_.stretch" ss "" basicpoint pause)
  (setvar "ORTHOMODE" oldorh) ;;;恢复正交
  (setvar "OSMODE" oldosm) ;;;;;恢复捕捉
  (princ)
)

ll_j

感觉CAD的拉升命令原本就可以了，尤其高版本CAD，已经很智能。这么多年来，一直只是在acad.lsp中加了(defun C:S()(command "stretch""c"))一句，完全够用了。

htlaser

(defun c:st1( / dx1  dx2 )
        (setq dx2 (getstring "\n命令:请输入板厚往左拉伸): "))
        (cond
                ((= DX2 "0.8")        (setq dx1        (list        -1.25        0        )))
                ((= DX2 "1")          (setq dx1        (list        -1.6        0        )))
                ((= DX2 "1.2")        (setq dx1        (list        -2        0        )))
                ((= DX2 "1.5")        (setq dx1        (list        -2.5        0        )))
                ((= DX2 "2")          (setq dx1        (list        -3.3        0        )))
                ((= DX2 "2.5")        (setq dx1        (list        -4        0        )))
                ((= DX2 "3")          (setq dx1        (list        -5        0        )))
                ((= DX2 "4")          (setq dx1        (list        -6.8        0        )))
                ((= DX2 "5")          (setq dx1        (list        -9        0        )))
                ((= DX2 "6")          (setq dx1        (list        -10        0        )))
                (t (setq dx1 (list 0 0))))
        (princ "\n-->请框选拉伸物体到折弯位置左拉伸:")
        (command
                "stretch" "c" pause pause "" '(0 0)         dx1
                "stretch" "c" pause pause "" '(0 0)         dx1
                "stretch" "c" pause pause "" '(0 0)         dx1
                "stretch" "c" pause pause "" '(0 0)         dx1
                "stretch" "c" pause pause "" '(0 0)         dx1
                "stretch" "c" pause pause "" '(0 0)         dx1
                "stretch" "c" pause pause "" '(0 0)         dx1
                "stretch" "c" pause pause "" '(0 0)         dx1
        )        (princ))

dcl1214

防止用户半路按下了esc，我屏蔽了esc，代码如下：

1. (defun c:dd (/ ss oldorh oldosm PT0)
   
2.   (vl-cmdf "select" "c" pause)
   
3.   (vl-catch-all-apply
   
4.     (function (lambda (/ SS PT0 ORTHOMODE OSMODE)
   
5.                 (if (setq ss (ssget "p"))
   
6.                   (progn
   
7.                     (setq ORTHOMODE (getvar "ORTHOMODE"))
   
8.                     (setq OSMODE (getvar "OSMODE"))
   
9.                     (setvar "ORTHOMODE" 1)
   
10.                     (setvar "OSMODE" 16383)
    
11.                     (setq PT0
    
12.                            (vl-catch-all-apply
    
13.                              'getpoint
    
14.                              (list "请点击左键指定基点或者输入距离数字:")
    
15.                            )
    
16.                     )
    
17.                     (if        PT0
    
18.                       ()
    
19.                       (setq PT0 (nth 1 (grread 5)))
    
20.                     )
    
21.                     (VL-CMDF "_.stretch" ss "" PT0 pause)
    
22.                     (setvar "ORTHOMODE" ORTHOMODE)
    
23.                     (setvar "OSMODE" OSMODE)
    
24.                   )
    
25.                 )
    
26.                 (SETQ SS NIL)
    
27.               )
    
28.     )
    
29.   )
    
30. )

(defun c:dd (/ ss oldorh oldosm PT0)<br />   (vl-cmdf "select" "c" pause)<br />   (vl-catch-all-apply<br />     (function (lambda (/ SS PT0 ORTHOMODE OSMODE)<br />                 (if (setq ss (ssget "p"))<br />                   (progn<br />                     (setq ORTHOMODE (getvar "ORTHOMODE"))<br />                     (setq OSMODE (getvar "OSMODE"))<br />                     (setvar "ORTHOMODE" 1)<br />                     (setvar "OSMODE" 16383)<br />                     (setq PT0<br />                            (vl-catch-all-apply<br />                              'getpoint<br />                              (list "请点击左键指定基点或者输入距离数字:")<br />                            )<br />                     )<br />                     (if        PT0<br />                       ()<br />                       (setq PT0 (nth 1 (grread 5)))<br />                     )<br />                     (VL-CMDF "_.stretch" ss "" PT0 pause)<br />                     (setvar "ORTHOMODE" ORTHOMODE)<br />                     (setvar "OSMODE" OSMODE)<br />                   )<br />                 )<br />                 (SETQ SS NIL)<br />               )<br />     )<br />   )<br /> )

G〆h

感觉不如原CAD命令直观！没有虚线表示位置等。

依然小小鸟

感觉楼主的实力是有的 但是研究偏了  大材小用了

e2002

拖拽效果，AutoLISP目前就莫指望了。

记忆距离这个还是很简单的。
你上面代码改改就可以了，
例如if 改为while，
在循环内可以一直保存所有之前输入过的距离值，并出现在提示字符串中。
你的提示字符串修改为标准写法: 选项们用“[]”包住，各选项如果用中文，光键字母用“()”包住。

很早以前就写过这种，那时候是做多重选择集的共同stretch的。后来stretch命令改进了支持多个不同位置的对象了，就不再需要那个老程序。
就如上面沙发贴中说的，固然标准stretch命令不够好用（缺少距离值记忆等），但程序因为getpoint不支持动态，写这么个程序没什么实际意义。
如果需要重复多次操作，之前的输入距离值可以用光标键往回翻出来也就是了。

琴剑江山_10184

你想的效果是这样的吧，与原有的一样有动态效果，可以点选点，也可以输入，还可以设默输入值，记住上次的输入

panliang9

不知道楼主要不要这样的，类似尺寸驱动，实际上也是stretch,这是我用的软件集成的功能，单独的没有。

lingduwx

看了楼主的功能，我在使用过程中觉得拉伸也应该加强一点，除了cad自带拉伸的基本功能，如果再增加参照就好 了，例如我需要拉伸线端点1，可以参照2为起点拉长至3点

琴剑江山_10184

琴剑江山_10184 发表于 2019-7-9 10:48
你想的效果是这样的吧，与原有的一样有动态效果，可以点选点，也可以输入，还可以设默输入值，记住上次的输 ...

别人的工具里面的功能