编程申请：指定图元基点与目标点间距移动物体

半听可乐

比如说我要进行这样的操作：移动图中已经存在的一个圆（或者其他图元，一个或多个），使得这个圆的圆心距离某道墙1000的距离，常规操作是先移动圆使其圆心位于墙边----再移动圆使其圆心偏离墙边1000距离

可不可以这样优化：运行程序--选择圆（或者其他图元集）并指定移动基点，选择目标直线（比如墙线）--输入移动基点与目标直线的距离1000---圆（或者其他图元集）正交移动至距离目标直线1000的位置

描述看起来很麻烦，实际操作其实很简单，希望大家能理解！

Andyhon

(defun C:MfDist ()
   ;; 选择圆 / ...
   (setq ss (ssget))
   
   ;; 指定移动基点
   (setq pt (GetPoint "\n指定移动基点: "))
   
   ;; 选择目标直线
   (prompt "\n选择目标直线: ")
   (setq ee (ssget ":E:S")
         ee (ssname ee 0)
   )
   
   ;; 输入移动基点与目标直线的距离1000 / 500 / ...
   (setq dd (getDist "\n输入移动基点与目标直线的距离: "))
   
   (setq px (vlax-curve-getClosestPointTo ee pt)
         p2 (polar px (angle px pt) dd)
   )
   (vl-cmdf "Move" ss "" pt "non" p2)
   (princ)
)

Andyhon

未见调试样图,且自行先试 vlax-curve-getClosestPointTo 函数

半听可乐

Andyhon 发表于 2012-7-31 21:20
未见调试样图,且自行先试 vlax-curve-getClosestPointTo 函数

已经添加，请帮忙

半听可乐

Andyhon 发表于 2012-7-31 21:54
(defun C:MfDist ()
   ;; 选择圆 / ...
   (setq ss (ssget))

朋友，你动作真是迅猛啊！程序也非常好用！感激不尽！

xyp1964

2. 
   
3. ;; 伪源码需要e派工具箱(XCAD)的支持
   
4. (defun c:tt ()
   
5.   (CMDLA0)
   
6.   (setq s0 (car (entsel "\n选择目标: ")))
   
7.   (redraw s0 3)
   
8.   (princ "\n圆实体: ")
   
9.   (setq ss (ssget '((0 . "circle")))
   
10. i  -1
    
11.   )
    
12.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
13.     (setq pt (xyp-get-dxf 10 s1)
    
14.    p1 (vlax-curve-getclosestpointto s0 pt)
    
15.    p1 (polar p1 (angle p1 pt) 1000)
    
16.     )
    
17.     (xyp-move s1 pt p1)
    
18.   )
    
19.   (redraw s0 4)
    
20.   (CMDLA1)
    
21. )
    

<br /> ;; 伪源码需要e派工具箱(XCAD)的支持<br /> (defun c:tt ()<br />   (CMDLA0)<br />   (setq s0 (car (entsel "\n选择目标: ")))<br />   (redraw s0 3)<br />   (princ "\n圆实体: ")<br />   (setq ss (ssget '((0 . "circle")))<br /> i  -1<br />   )<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq pt (xyp-get-dxf 10 s1)<br />    p1 (vlax-curve-getclosestpointto s0 pt)<br />    p1 (polar p1 (angle p1 pt) 1000)<br />     )<br />     (xyp-move s1 pt p1)<br />   )<br />   (redraw s0 4)<br />   (CMDLA1)<br /> )<br />

半听可乐

Andyhon 发表于 2012-7-31 21:11
(defun C:MfDist ()
   ;; 选择圆 / ...
   (setq ss (ssget))

对了朋友，能不能将程序优化一下，使得当目标直线是块中的一条直线或多段线中一条线段时也管用呢？另外，经试用发现一个小bug：如果从图元基点出发到目标直线的垂线与目标直线不相交，则移动后基点与目标直线的距离会比输入值小

Andyhon

样本对象导引着思路来建立代码片断....
是以要能涵盖实务所需,用以避免造成状况外

2. 
   
3. (defun C:MfDist ()
   
4.    ;; 选择圆 / ...
   
5.    (setq ss (ssget))
   
6. 
   
7.    ;; 指定移动基点
   
8.    (setq pt (GetPoint "\n指定移动基点: "))
   
9. 
   
10.    ;; 选择目标直线
    
11.    (setq ee (nentsel "\n选择目标直线: ")
    
12.          pa (cadr ee)
    
13.          pb (osnap pa "mid")
    
14.          pa (osnap pb "end")
    
15.    )
    
16. 
    
17.    ;; 输入移动基点与目标直线的距离1000 / 500 / ...
    
18.    (setq dd (getDist "\n输入移动基点与目标直线的距离: "))
    
19. 
    
20.    (vl-cmdf "Xline" "none" pa "none" pb "")
    
21.    (setq ee (entlast)
    
22.          px (vlax-curve-getClosestPointTo ee pt)
    
23.          p2 (polar px (angle px pt) dd)
    
24.    )
    
25.    (vl-cmdf "Move" ss "" pt "none" p2)
    
26.    (entdel ee)
    
27.    (princ)
    
28. )
    

<br /> (defun C:MfDist ()<br />    ;; 选择圆 / ...<br />    (setq ss (ssget))<br /> <br />    ;; 指定移动基点<br />    (setq pt (GetPoint "\n指定移动基点: "))<br /> <br />    ;; 选择目标直线<br />    (setq ee (nentsel "\n选择目标直线: ")<br />          pa (cadr ee)<br />          pb (osnap pa "mid")<br />          pa (osnap pb "end")<br />    )<br /> <br />    ;; 输入移动基点与目标直线的距离1000 / 500 / ...<br />    (setq dd (getDist "\n输入移动基点与目标直线的距离: "))<br /> <br />    (vl-cmdf "Xline" "none" pa "none" pb "")<br />    (setq ee (entlast)<br />          px (vlax-curve-getClosestPointTo ee pt)<br />          p2 (polar px (angle px pt) dd)<br />    )<br />    (vl-cmdf "Move" ss "" pt "none" p2)<br />    (entdel ee)<br />    (princ)<br /> )<br />

Try again

半听可乐

Andyhon 发表于 2012-8-1 08:54
样本对象导引着思路来建立代码片断....
是以要能涵盖实务所需,用以避免造成状况外 Try again

这下更强大了，真给力！谢谢！

preone

学习~~