关于修改多线段顶点表

ysq101

需求以下功能职：
框选闭合多线段（数量2000以上）
修改全部顶点表的座标精度：
如XXX.XXXXXXXX 更新为XXX.XXX
    YYY.YYYYYYYY更新为YYY.YYY

子函数都找好了。。无奈太久没玩LISP。对不起大家的教导了
以下子程序摘自 自贡黄明儒

2. ;;164.35 [功能] 多段线修改顶点 By 自贡黄明儒
   
3. ;;示例(HH:ModifyVertex (car(setq en(entsel))) (cadr en) (getpoint))
   
4. (defun HH:ModifyVertex (en pt newPt / ENT L1 L2 NPT P P10)
   
5.   (setq p (HH:PickClosePt en pt))
   
6.   (setq p10 (list 10 (car p) (cadr p)))
   
7.   (setq ent (entget en))
   
8.   (setq L2 (cdr (member p10 ent)))
   
9.   (setq L1 (reverse (cdr (member p10 (reverse ent)))))
   
10.   (setq Npt (list (list 10 (car newPt) (cadr newPt))))
    
11.   (entmod (append L1 Npt L2))
    
12. )
    
13. ;;(HH:ModifyVertex1 (car(setq en(entsel))) (cadr en)) By 自贡黄明儒
    
14. (defun HH:ModifyVertex1        (en p / ENT GR L1 L2 NPT P10)
    
15.   (setq ent (entget en))
    
16.   (setq pt (HH:PickClosePt en p))
    
17.   (setq p10 (list 10 (car pt) (cadr pt)))
    
18.   (setq L2 (cdr (member p10 ent)))
    
19.   (setq L1 (reverse (cdr (member p10 (reverse ent)))))
    
20.   (while (and (setq gr (grread 5)) (= (car gr) 5))
    
21.     (setq Npt (list (list 10 (car (cadr gr)) (cadr (cadr gr)))))
    
22.     (entmod (append L1 Npt L2))
    
23.   )
    
24. )
    
25. 
    
26. 
    
27. ;-----------------------------------------------------
    
28. 
    
29. 
    
30. ;;164.3 [功能] 多段线端点列表 By 自贡黄明儒
    
31. ;;示例(HH:PtLists (car (entsel)))
    
32. (defun HH:PtLists (en)
    
33.   (mapcar 'cdr
    
34.           (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
    
35.   )
    
36. )
    
37. 
    
38. 
    
39. 
    

;;164.35 [功能] 多段线修改顶点 By 自贡黄明儒<br /> ;;示例(HH:ModifyVertex (car(setq en(entsel))) (cadr en) (getpoint))<br /> (defun HH:ModifyVertex (en pt newPt / ENT L1 L2 NPT P P10)<br />   (setq p (HH:PickClosePt en pt))<br />   (setq p10 (list 10 (car p) (cadr p)))<br />   (setq ent (entget en))<br />   (setq L2 (cdr (member p10 ent)))<br />   (setq L1 (reverse (cdr (member p10 (reverse ent)))))<br />   (setq Npt (list (list 10 (car newPt) (cadr newPt))))<br />   (entmod (append L1 Npt L2))<br /> )<br /> ;;(HH:ModifyVertex1 (car(setq en(entsel))) (cadr en)) By 自贡黄明儒<br /> (defun HH:ModifyVertex1        (en p / ENT GR L1 L2 NPT P10)<br />   (setq ent (entget en))<br />   (setq pt (HH:PickClosePt en p))<br />   (setq p10 (list 10 (car pt) (cadr pt)))<br />   (setq L2 (cdr (member p10 ent)))<br />   (setq L1 (reverse (cdr (member p10 (reverse ent)))))<br />   (while (and (setq gr (grread 5)) (= (car gr) 5))<br />     (setq Npt (list (list 10 (car (cadr gr)) (cadr (cadr gr)))))<br />     (entmod (append L1 Npt L2))<br />   )<br /> )<br /> <br /> <br /> ;-----------------------------------------------------<br /> <br /> <br /> ;;164.3 [功能] 多段线端点列表 By 自贡黄明儒<br /> ;;示例(HH:PtLists (car (entsel)))<br /> (defun HH:PtLists (en)<br />   (mapcar 'cdr<br />           (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))<br />   )<br /> )<br /> <br /> <br /> <br />

tanwei

看看是什么

vectra

1. (defun c:fix (/ dxf e ent i ss)
   
2. 
   
3.   (defun fixpoint (p n / div)
   
4.     (setq div (expt 10. n))
   
5.     (mapcar '(lambda (e) (/ (fix (* div e)) div)) p)
   
6.   )
   
7. 
   
8.   (defun fixdxf        (dxf)
   
9.     (setq dxf
   
10.            (mapcar
    
11.              '(lambda (e)
    
12.                 (if (= (car e) 10)
    
13.                   (cons 10 (fixpoint (cdr e) 3))
    
14.                   e
    
15.                 )
    
16.               )
    
17.              dxf
    
18.            )
    
19.     )
    
20.     (entmod dxf)
    
21.   )
    
22. 
    
23.   (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))))
    
24.   (if ss
    
25.     (progn
    
26. 
    
27.       (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
    
28. 
    
29.       (repeat (setq i (sslength ss))
    
30.         (setq ent (ssname ss (setq i (1- i)))
    
31.               dxf (entget ent)
    
32.         )
    
33.         (fixdxf dxf)
    
34.       )
    
35. 
    
36.       (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    
37.     )
    
38.   )
    
39.   (princ)
    
40. )

(defun c:fix (/ dxf e ent i ss)<br /> <br />   (defun fixpoint (p n / div)<br />     (setq div (expt 10. n))<br />     (mapcar '(lambda (e) (/ (fix (* div e)) div)) p)<br />   )<br /> <br />   (defun fixdxf        (dxf)<br />     (setq dxf<br />            (mapcar<br />              '(lambda (e)<br />                 (if (= (car e) 10)<br />                   (cons 10 (fixpoint (cdr e) 3))<br />                   e<br />                 )<br />               )<br />              dxf<br />            )<br />     )<br />     (entmod dxf)<br />   )<br /> <br />   (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))))<br />   (if ss<br />     (progn<br /> <br />       (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))<br /> <br />       (repeat (setq i (sslength ss))<br />         (setq ent (ssname ss (setq i (1- i)))<br />               dxf (entget ent)<br />         )<br />         (fixdxf dxf)<br />       )<br /> <br />       (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))<br />     )<br />   )<br />   (princ)<br /> )

llsheng_73

1. (defun fixxy(e n / a)
   
2.   (entmod(reverse(foreach x(entget e)
   
3.      (setq a(cons(if(member(car x)'(10 11 12 13 14))
   
4.      (cons(car x)(mapcar'(lambda(x)(- x(rem x n)))(cdr x)))x)a))))))
   
5. (defun c:t1(/ e n)
   
6.   (setq n(getreal"坐标精度小数位<3>:")
   
7. n(if(>= n 0)n 3)
   
8. n(expt 10.(- n))
   
9. e(princ"\n"))
   
10.   (while(progn(prompt"\r选择多段线")
    
11.   (setq e(ssget":E:S"'((0 . "lwpolyline")))))
    
12.     (fixxy(ssname e 0)n))
    
13.   (princ))
    
14. (defun c:t2(/ e n i)
    
15.   (setq n(getreal"坐标精度小数位<3>:")
    
16. n(if(>= n 0)n 3)
    
17. n(expt 10.(- n))
    
18. e(princ"\选择多段线")
    
19. e(ssget))
    
20.   (if e(repeat(setq i(sslength e))
    
21.   (setq i(1- i))
    
22.   (fixxy(ssname e i)n))))

(defun fixxy(e n / a)<br />   (entmod(reverse(foreach x(entget e)<br />      (setq a(cons(if(member(car x)'(10 11 12 13 14))<br />      (cons(car x)(mapcar'(lambda(x)(- x(rem x n)))(cdr x)))x)a))))))<br /> (defun c:t1(/ e n)<br />   (setq n(getreal"坐标精度小数位<3>:")<br /> n(if(>= n 0)n 3)<br /> n(expt 10.(- n))<br /> e(princ"\n"))<br />   (while(progn(prompt"\r选择多段线")<br />   (setq e(ssget":E:S"'((0 . "lwpolyline")))))<br />     (fixxy(ssname e 0)n))<br />   (princ))<br /> (defun c:t2(/ e n i)<br />   (setq n(getreal"坐标精度小数位<3>:")<br /> n(if(>= n 0)n 3)<br /> n(expt 10.(- n))<br /> e(princ"\选择多段线")<br /> e(ssget))<br />   (if e(repeat(setq i(sslength e))<br />   (setq i(1- i))<br />   (fixxy(ssname e i)n))))

ysq101

vectra 发表于 2017-12-13 20:29

谢谢大师出手相助。。。。。。。

ysq101

llsheng_73 发表于 2017-12-14 09:05

谢谢大师出手相助