[LISP程序]：增加顶点，用于LWPOLYLINE

6分钟

2. 
   
3. (defun c:Aee ( / en el EL1 el2 et oldos pt PT1 PT2  test1 TEST2)
   
4. (while
   
5. (not
   
6.   (eq "LWPOLYLINE" (setq en(car(entsel "\n请选择LWPOLYLINE"))
   
7.                         el(entget en)
   
8.                         et(cdr (assoc 0 el))))))
   
9. (redraw en 3)
   
10. (setq OLDOS (getvar "OSMODE"))
    
11. (setvar "OSMODE" 1)
    
12. (setq PT1 (getpoint "\n请选择第一个点")
    
13.       PT2 (getpoint "\n请选择第二个点")
    
14.       TEST1 (cons 10 (list (car PT1)(cadr PT1)))
    
15.       TEST2 (cons 10 (list (car PT2)(cadr PT2)))      
    
16.       EL2 (member TEST2 EL))
    
17. (if(member TEST1 EL2)(setq PT PT1 PT1 PT2 PT2 PT TEST TEST1 TEST1 TEST2 TEST2 TEST))
    
18. (setq EL1(reverse(member TEST1 (reverse EL)))
    
19.       EL2(member TEST2 EL)
    
20.       PT (getpoint "\n请输入要增加的点"))
    
21. (setq EL (append EL1 (list(cons 10 (list (car PT)(cadr PT))))  EL2))   
    
22. (entmod EL)
    
23. (entupd EN)
    
24. (setvar "OSMODE" OLDOS))
    

<br /> (defun c:Aee ( / en el EL1 el2 et oldos pt PT1 PT2  test1 TEST2) <br /> (while <br /> (not <br />   (eq "LWPOLYLINE" (setq en(car(entsel "\n请选择LWPOLYLINE")) <br />                         el(entget en) <br />                         et(cdr (assoc 0 el)))))) <br /> (redraw en 3) <br /> (setq OLDOS (getvar "OSMODE")) <br /> (setvar "OSMODE" 1) <br /> (setq PT1 (getpoint "\n请选择第一个点") <br />       PT2 (getpoint "\n请选择第二个点") <br />       TEST1 (cons 10 (list (car PT1)(cadr PT1))) <br />       TEST2 (cons 10 (list (car PT2)(cadr PT2)))      <br />       EL2 (member TEST2 EL)) <br /> (if(member TEST1 EL2)(setq PT PT1 PT1 PT2 PT2 PT TEST TEST1 TEST1 TEST2 TEST2 TEST)) <br /> (setq EL1(reverse(member TEST1 (reverse EL))) <br />       EL2(member TEST2 EL) <br />       PT (getpoint "\n请输入要增加的点")) <br /> (setq EL (append EL1 (list(cons 10 (list (car PT)(cadr PT))))  EL2))    <br /> (entmod EL) <br /> (entupd EN) <br /> (setvar "OSMODE" OLDOS))<br />

liub951030

用起来不是很方便,能不能不用选顶点?