矩形边拉伸固定值，请帮修改加强一下(能记忆值更好)

ww5w

点多边形的边拉抻
(setq ent (entsel"\n请选择要拉伸线段:"))
(setq PNT (apply 'vlax-curve-getClosestPointTo ENT))
(setq ENT (car ENT))
(setq PP  (fix (vlax-curve-getParamAtPoint ENT PNT)))
(setq pa (vlax-curve-getPointAtParam ENT  PP);;节点1
       pb (vlax-curve-getPointAtParam ENT (1+ PP)) ) ;;节点2
(command "_.stretch" "c" "non" pa "non" Pb "" "non" pnt )  ; 想在指定方向后自动拉伸啦0.5，这里的要怎么弄?
谢谢.

st788796

用lengthen更好
看错了，高版本cad有grippoint 了

newer

先得到STRETCHPOINT点。

st788796

其中的一种方法，没有写 *error* ，这个方法不能用记忆距离

1. (defun c:tt (/ callback e p0 pts spt i1 i2 p00)
   
2.   (defun callback (dynpt / v)
   
3.     (setq v (mapcar '- dynpt p0))
   
4.     (xdrx_entity_movestretchpoint (car e) v i1 i2)
   
5.     (setq p0 dynpt)
   
6.   )
   
7.   (if (setq e (xdrx_entsel "\nPick Pline: " '((0 . "*polyline"))))
   
8.     (progn
   
9.       (setq p0 (trans (cadr e) 1 0)
   
10.      p00 p0
    
11.      pts (xdrx_polyline_getlinesegat
    
12.     (car e)
    
13.     (fix (vlax-curve-getparamatpoint
    
14.     (car e)
    
15.     (apply 'vlax-curve-getclosestpointto e)
    
16.          )
    
17.     )
    
18.   )
    
19.      spt (xdrx_entity_getstretchpoint (car e))
    
20.      i1 (vl-position (car pts) spt)
    
21.      i2 (vl-position (cadr pts) spt)
    
22.       )
    
23.       (xdrx_pointmonitor "callback" (car e))
    
24.       (setq p (getpoint (cadr e) "\nDist: "))
    
25.       (xdrx_pointmonitor)
    
26.     )
    
27.   )
    
28.   (princ)
    
29. )

(defun c:tt (/ callback e p0 pts spt i1 i2 p00)<br />   (defun callback (dynpt / v)<br />     (setq v (mapcar '- dynpt p0))<br />     (xdrx_entity_movestretchpoint (car e) v i1 i2)<br />     (setq p0 dynpt)<br />   )<br />   (if (setq e (xdrx_entsel "\nPick Pline: " '((0 . "*polyline"))))<br />     (progn<br />       (setq p0 (trans (cadr e) 1 0)<br />      p00 p0<br />      pts (xdrx_polyline_getlinesegat<br />     (car e)<br />     (fix (vlax-curve-getparamatpoint<br />     (car e)<br />     (apply 'vlax-curve-getclosestpointto e)<br />          )<br />     )<br />   )<br />      spt (xdrx_entity_getstretchpoint (car e))<br />      i1 (vl-position (car pts) spt)<br />      i2 (vl-position (cadr pts) spt)<br />       )<br />       (xdrx_pointmonitor "callback" (car e))<br />       (setq p (getpoint (cadr e) "\nDist: "))<br />       (xdrx_pointmonitor)<br />     )<br />   )<br />   (princ)<br /> )

ww5w

谢谢楼上的前辈。
我弄了个简单先解决一下用着.
(setq p1 (getpoint pnt "\n指定拉伸方向 :"))
(setq p2 (polar pnt (angle pnt p1) 0.5))
(command "_.stretch" "c" "non" pa "non" Pb "" "non" pnt "non" p2)
;;;现在还有个问题是p1要用鼠标点，如果用空格就退出了，
不知用什么办法可以在指点p1点时，移动鼠标后点左键或空格都可以确定p1点.

Free-Lancer

ww5w 发表于 2013-10-4 10:00
谢谢楼上的前辈。
我弄了个简单先解决一下用着.
(setq p1 (getpoint pnt "\n指定拉伸方向 :"))

没有点是确定不了方向的，所以回车时要取得当前鼠标点坐标，可用的函数  
1

1. (if (not (setq p1 (getpoint pnt "\nDirection: ")))
   
2.   (setq p1 (xdrx_document_getmousecoord))
   
3. )
   

(if (not (setq p1 (getpoint pnt "\nDirection: ")))<br />   (setq p1 (xdrx_document_getmousecoord))<br /> )<br />

2

1. (if (not (setq p1 (getpoint pnt "\nDirection: ")))
   
2.   (setq p1 (cadr (grread 1 0)))
   
3. )

(if (not (setq p1 (getpoint pnt "\nDirection: ")))<br />   (setq p1 (cadr (grread 1 0)))<br /> )

ww5w

Free-Lancer 发表于 2013-10-4 11:07
没有点是确定不了方向的，所以回车时要取得当前鼠标点坐标，可用的函数  
1
2

谢谢，解决了.