直线命令的增强

--@-----

Free-Lancer 发表于 2013-9-3 11:42
简单示意, 适用Cad 2011 + xdapi

虽然这个功能有了 但是原直线的功能没了  原直线还可以输入距离的 可以捕捉画线。所以整合起来应该不简单{:soso_e100:}

--@-----

--@----- 发表于 2013-9-7 00:49
虽然这个功能有了 但是原直线的功能没了  原直线还可以输入距离的 可以捕捉画线。所以整合起来应该不简单 ...

这个延长到最近的物体上，现在这个是鼠标要是拉的超过最近的物体 就会延过于此。

Free-Lancer

--@----- 发表于 2013-9-7 00:52
这个延长到最近的物体上，现在这个是鼠标要是拉的超过最近的物体 就会延过于此。

Pause 中可以写很多内容

1. (defun c:tt (/ GetOrthoPt aa p tf lent)
   
2.   (defun GetOrthoPt (p p1 / p)
   
3.     (if    (= (getvar "ORTHOMODE") 1)
   
4.       (if (or
   
5.         (<= (angle p p1) (* 0.25 pi))
   
6.         (> (angle p p1) (* 1.5 pi))
   
7.         (<= (* 0.75 pi) (angle p p1) (* 1.25 pi))
   
8.       )
   
9.     (setq p (list (car p1) (cadr p) 0.))
   
10.     (setq p (list (car p) (cadr p1) 0.))
    
11.       )
    
12.       p1
    
13.     )
    
14.   )
    
15.   (setvar "cmdecho" 1)
    
16.   (setq lent (entlast))
    
17.   (vl-cmdf ".line")
    
18.   (while (/= (getvar "cmdactive") 0)
    
19.     ;;(vl-cmdf pause)
    
20.     (setq aa (grread))
    
21.     (cond
    
22.       ((= (car aa) 3)
    
23.        (if tf
    
24.      (progn
    
25.        (setq p (getvar "lastpoint")
    
26.          p (getorthopt p (cadr aa))
    
27.        )
    
28.        (vl-cmdf p)
    
29.      )
    
30.      (progn
    
31.        (setq tf t)
    
32.        (vl-cmdf (setq p (cadr aa)))
    
33.      )
    
34.        )
    
35.       )
    
36.       ((= (cadr aa) 32) ;_空格      
    
37.        (vl-cmdf
    
38.      (GetOrthoPt (getvar "lastpoint") (cadr (grread aa)))
    
39.        ) ;_多绘制一段
    
40.        (vl-cmdf "")
    
41.        (if (/= (entlast) lent);_鼠标不需要超过要延伸实体
    
42.      (vl-cmdf ".extend"
    
43.           "all"
    
44.           ""
    
45.           (list (entlast) (getvar "lastpoint"))
    
46.           ""
    
47.      )
    
48.        )
    
49.       )
    
50.       (t (vl-cmdf pause))
    
51.     )
    
52.   )
    
53.   (princ)
    
54. )

(defun c:tt (/ GetOrthoPt aa p tf lent)<br />   (defun GetOrthoPt (p p1 / p)<br />     (if    (= (getvar "ORTHOMODE") 1)<br />       (if (or<br />         (<= (angle p p1) (* 0.25 pi))<br />         (> (angle p p1) (* 1.5 pi))<br />         (<= (* 0.75 pi) (angle p p1) (* 1.25 pi))<br />       )<br />     (setq p (list (car p1) (cadr p) 0.))<br />     (setq p (list (car p) (cadr p1) 0.))<br />       )<br />       p1<br />     )<br />   )<br />   (setvar "cmdecho" 1)<br />   (setq lent (entlast))<br />   (vl-cmdf ".line")<br />   (while (/= (getvar "cmdactive") 0)<br />     ;;(vl-cmdf pause)<br />     (setq aa (grread))<br />     (cond<br />       ((= (car aa) 3)<br />        (if tf<br />      (progn<br />        (setq p (getvar "lastpoint")<br />          p (getorthopt p (cadr aa))<br />        )<br />        (vl-cmdf p)<br />      )<br />      (progn<br />        (setq tf t)<br />        (vl-cmdf (setq p (cadr aa)))<br />      )<br />        )<br />       )<br />       ((= (cadr aa) 32) ;_空格       <br />        (vl-cmdf<br />      (GetOrthoPt (getvar "lastpoint") (cadr (grread aa)))<br />        ) ;_多绘制一段<br />        (vl-cmdf "")<br />        (if (/= (entlast) lent);_鼠标不需要超过要延伸实体<br />      (vl-cmdf ".extend"<br />           "all"<br />           ""<br />           (list (entlast) (getvar "lastpoint"))<br />           ""<br />      )<br />        )<br />       )<br />       (t (vl-cmdf pause))<br />     )<br />   )<br />   (princ)<br /> )

xyp1964

xyp1964

2. ;; [url]http://yunpan.cn/QXQKsW9gAPmpF[/url]
   
3. 
   
4. (defun c:tt ()
   
5.   (while (and (setq p1 (getpoint "\n基点<退出>: "))
   
6.               (setq p2 (getpoint p1 "\n基点<退出>: "))
   
7.          )
   
8.     (progn
   
9.       (setq ptn        (xyp-Get-ScreenCoord)
   
10.             dd        (distance (car ptn) (cadr ptn))
    
11.             s1        (xyp-line p1 (polar P1 (angle p1 p2) dd))
    
12.       )
    
13.       (if (setq ptn (xyp-Get-CurveIntersLeng s1 3))
    
14.         (xyp-line p1 (car ptn))
    
15.         (xyp-line p1 p2)
    
16.       )
    
17.       (xyp-erase s1)
    
18.     )
    
19.   )
    
20.   (princ)
    
21. )
    

;; [url]http://yunpan.cn/QXQKsW9gAPmpF[/url]<br /> <br /> (defun c:tt ()<br />   (while (and (setq p1 (getpoint "\n基点<退出>: "))<br />               (setq p2 (getpoint p1 "\n基点<退出>: "))<br />          )<br />     (progn<br />       (setq ptn        (xyp-Get-ScreenCoord)<br />             dd        (distance (car ptn) (cadr ptn))<br />             s1        (xyp-line p1 (polar P1 (angle p1 p2) dd))<br />       )<br />       (if (setq ptn (xyp-Get-CurveIntersLeng s1 3))<br />         (xyp-line p1 (car ptn))<br />         (xyp-line p1 p2)<br />       )<br />       (xyp-erase s1)<br />     )<br />   )<br />   (princ)<br /> )<br />