LISPZHUAN

kexiya123

有没有动态延长直线的LISP程序呢

苗凱

1. (defun c:ff ( / ka01 pt1 KENT KENTLIST karc knea ka1 ka2 ka3 ka4 klj pt11 )  
   
2.    (setq ka01 (entsel "请选择直线或圆弧:"))(if ka01
   
3. (progn(setq  KENT (car ka01))(setq KENTLIST (entget KENT))
   
4. (if(not(or(eq "ARC" (cdr(assoc 0 KENTLIST)))(eq "LINE" (cdr(assoc 0 KENTLIST)))))
   
5.      (princ "\n您选择的不是直线或圆弧!")        (progn(princ "\n按右键显示路径.")
   
6.    (setq pt1 (cadr ka01))(setq  KENT (car ka01))(setq KENTLIST (entget KENT))
   
7.    (if (eq "ARC" (cdr(assoc 0 KENTLIST)))(setq karc t)(setq karc nil))
   
8.    (setq ka1 (vlax-ename->vla-object KENT))
   
9.    (if (<(distance pt1 (vlax-curve-getStartPoint ka1))(distance pt1
   
10.          (vlax-curve-getEndPoint ka1)))(setq knea t)(setq knea nil))
    
11.    (while ka1
    
12.      (setq ka2 (grread t 12 2) ka3 (car ka2)  ka4 (cadr ka2))
    
13.       (if (= ka3 25)(if klj(setq klj nil)(setq klj t)))
    
14.      (cond ((= ka3 5)
    
15.             (progn (setq pt11 (vlax-curve-getClosestPointTo ka1 ka4 t))
    
16.     (if(not karc)(if knea
    
17.                    (if (> (distance pt11 (vlax-curve-getEndPoint ka1)) 0.1)                  
    
18.                    (vla-put-StartPoint ka1 (vlax-3d-point pt11)))
    
19.                    (if(> (distance pt11 (vlax-curve-getStartPoint ka1)) 0.1)
    
20.            (vla-put-EndPoint ka1 (vlax-3d-point pt11)))
    
21.                    )
    
22.          (if knea(vlax-put-property ka1 'StartAngle (angle (cdr(assoc 10 KENTLIST))pt11))
    
23.             (vlax-put-property ka1 'EndAngle (angle (cdr(assoc 10 KENTLIST))pt11))))
    
24.                        (if klj (progn(redraw)(grdraw ka4 pt11 2 4)))
    
25.                        )
    
26.             )
    
27.            ((= ka3 3)(setq ka1 nil))         
    
28.            ;((= ka3 25)(princ ka3)(princ ka4))
    
29.            ;(t (princ ka2)(princ "  "))
    
30.            ;(t (princ ka3)(princ ",")(princ ka4)(princ " "))
    
31.            )) )) )) (redraw) (princ)
    
32.      )

复制代码