怎么去掉点选模式，输入距离，直接批量框选哪边就延长那边

纵横八方

(defun c:vv( / d)
  (setq d (getdist "\n延伸长度:"))            
  (if (and (setq ss (ssget '((0 . "LINE,ARC,ELLIPSE,*POLYLINE"))))
              (setq pt (getpoint "\n延伸方向:"))            
      )
    (progn
      (command "lengthen" "de" d)
      (repeat (setq n (sslength ss))
      (command (list (setq e (ssname ss (setq n (1- n)))) pt))           
      )
      (command "")
    )
  )
  (princ)
)

ssyfeng

把if换成while就行了

2. (defun c:vv (/ D E N P0 P1 SS)
   
3.   (setq d (getdist "\n延伸长度:"))
   
4.   (while (and (setq p0 (getpoint "\n框选对象第一对角点(会以此点做为延伸方向):"))
   
5.            (setq p1 (getcorner p0 "\n框选对象另一对角点:"))
   
6.            (setq ss (ssget "c" p0 p1 '((0 . "LINE,ARC,ELLIPSE,*POLYLINE"))))
   
7.          )
   
8.     (progn
   
9.       (command "lengthen" "de" d)
   
10.       (repeat (setq n (sslength ss))
    
11.         (command (list (setq e (ssname ss (setq n (1- n)))) p0))
    
12.       )
    
13.       (command "")
    
14.     )
    
15.   )
    
16.   (princ)
    
17. )

(defun c:vv (/ D E N P0 P1 SS)<br />   (setq d (getdist "\n延伸长度:"))<br />   (while (and (setq p0 (getpoint "\n框选对象第一对角点(会以此点做为延伸方向):"))<br />            (setq p1 (getcorner p0 "\n框选对象另一对角点:"))<br />            (setq ss (ssget "c" p0 p1 '((0 . "LINE,ARC,ELLIPSE,*POLYLINE"))))<br />          )<br />     (progn<br />       (command "lengthen" "de" d)<br />       (repeat (setq n (sslength ss))<br />         (command (list (setq e (ssname ss (setq n (1- n)))) p0))<br />       )<br />       (command "")<br />     )<br />   )<br />   (princ)<br /> )

琴剑江山_10184

1. (defun c:vv (/ D E N P0 P1 SS)
   
2.   (setq d (getdist "\n延伸长度:"))
   
3.   (if
   
4.     (and (setq p0 (getpoint "\n框选对象第一对角点(会以此点做为延伸方向):"))
   
5.          (setq p1 (getcorner p0 "\n框选对象另一对角点:"))
   
6.          (setq ss (ssget "c" p0 p1 '((0 . "LINE,ARC,ELLIPSE,*POLYLINE"))))
   
7.     )
   
8.      (progn
   
9.        (command "lengthen" "de" d)
   
10.        (repeat (setq n (sslength ss))
    
11.          (command (list (setq e (ssname ss (setq n (1- n)))) p0))
    
12.        )
    
13.        (command "")
    
14.      )
    
15.   )
    
16.   (princ)
    
17. )

(defun c:vv (/ D E N P0 P1 SS)<br />   (setq d (getdist "\n延伸长度:"))<br />   (if<br />     (and (setq p0 (getpoint "\n框选对象第一对角点(会以此点做为延伸方向):"))<br />          (setq p1 (getcorner p0 "\n框选对象另一对角点:"))<br />          (setq ss (ssget "c" p0 p1 '((0 . "LINE,ARC,ELLIPSE,*POLYLINE"))))<br />     )<br />      (progn<br />        (command "lengthen" "de" d)<br />        (repeat (setq n (sslength ss))<br />          (command (list (setq e (ssname ss (setq n (1- n)))) p0))<br />        )<br />        (command "")<br />      )<br />   )<br />   (princ)<br /> )

sdls

琴剑江山_10184 发表于 2019-3-30 16:22

这个程序不错，如果加上记忆功能更完美！！

纵横八方

琴剑江山_10184 发表于 2019-3-30 16:22

怎么 加个循环，可以连继续 框选 下去就完美了

纵横八方

漂亮，要的就是这个效果

琴剑江山_10184

伤心了啊，代码我写出来，别人在我上面改一句，别人的还成最佳答案了

纵横八方

琴剑江山_10184 发表于 2019-4-1 19:05
伤心了啊，代码我写出来，别人在我上面改一句，别人的还成最佳答案了

哥，我错了 ，你看一下代码还有地方要完善的没，我后面就顶你

1028695446

纵横八方 发表于 2019-4-3 17:42
哥，我错了 ，你看一下代码还有地方要完善的没，我后面就顶你

;;我这个是在前面2个大师的基础上，优化的，因为上2位没有注意用户体验，比如选点的时候直接按了空格，没有选到点，程序依然会让用户继续选第二个点，然后选物体，之后报错，这种交互体验极差的:P
;;定距延长
(defun c:y1 (/ D E N P0 P1 SS)
  (setq d (getdist "\n延伸长度:"))
  (if(and
                        (if d (setq p0 (getpoint "\n框选对象第一对角点(会以此点做为延伸方向):")))
                        (if p0 (setq p1 (getcorner p0 "\n框选对象另一对角点:")))
                        (if (and p0 p1)(setq ss (ssget "c" p0 p1 '((0 . "LINE,ARC,ELLIPSE,*POLYLINE")))))
    )
                (progn
                        (command "lengthen" "de" d)
                        (repeat (setq n (sslength ss))
                                (command (list (setq e (ssname ss (setq n (1- n)))) p0))
                        )
                        (command "")
                )
  )
  (princ)
)
;;定距延长，继续框选
(defun c:y2 (/ D E N P0 P1 SS)
  (setq d (getdist "\n延伸长度:"))
  (while                (and
                                                        (if d (setq p0 (getpoint "\n框选对象第一对角点(会以此点做为延伸方向):")))
                                                        (if p0 (setq p1 (getcorner p0 "\n框选对象另一对角点:")))
                                                        (if (and p0 p1)(setq ss (ssget "c" p0 p1 '((0 . "LINE,ARC,ELLIPSE,*POLYLINE")))))
                                                )
                (progn
                        (command "lengthen" "de" d)
                        (repeat (setq n (sslength ss))
                                (command (list (setq e (ssname ss (setq n (1- n)))) p0))
                        )
                        (command "")
                )
                (setq p0 nil p1 nil ss nil)
  )
  (princ)
)

纵横八方

漂亮！多谢大师们优化