ysq101 发表于 2017-12-13 18:24:09

关于修改多线段顶点表

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

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




;;164.35 [功能] 多段线修改顶点 By 自贡黄明儒
;;示例(HH:ModifyVertex (car(setq en(entsel))) (cadr en) (getpoint))
(defun HH:ModifyVertex (en pt newPt / ENT L1 L2 NPT P P10)
(setq p (HH:PickClosePt en pt))
(setq p10 (list 10 (car p) (cadr p)))
(setq ent (entget en))
(setq L2 (cdr (member p10 ent)))
(setq L1 (reverse (cdr (member p10 (reverse ent)))))
(setq Npt (list (list 10 (car newPt) (cadr newPt))))
(entmod (append L1 Npt L2))
)
;;(HH:ModifyVertex1 (car(setq en(entsel))) (cadr en)) By 自贡黄明儒
(defun HH:ModifyVertex1      (en p / ENT GR L1 L2 NPT P10)
(setq ent (entget en))
(setq pt (HH:PickClosePt en p))
(setq p10 (list 10 (car pt) (cadr pt)))
(setq L2 (cdr (member p10 ent)))
(setq L1 (reverse (cdr (member p10 (reverse ent)))))
(while (and (setq gr (grread 5)) (= (car gr) 5))
    (setq Npt (list (list 10 (car (cadr gr)) (cadr (cadr gr)))))
    (entmod (append L1 Npt L2))
)
)


;-----------------------------------------------------


;;164.3 [功能] 多段线端点列表 By 自贡黄明儒
;;示例(HH:PtLists (car (entsel)))
(defun HH:PtLists (en)
(mapcar 'cdr
          (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget en))
)
)





tanwei 发表于 2017-12-13 18:29:21


看看是什么

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

(defun c:fix (/ dxf e ent i ss)

(defun fixpoint (p n / div)
    (setq div (expt 10. n))
    (mapcar '(lambda (e) (/ (fix (* div e)) div)) p)
)

(defun fixdxf        (dxf)
    (setq dxf
           (mapcar
             '(lambda (e)
                (if (= (car e) 10)
                  (cons 10 (fixpoint (cdr e) 3))
                  e
                )
              )
             dxf
           )
    )
    (entmod dxf)
)

(setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))))
(if ss
    (progn

      (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))

      (repeat (setq i (sslength ss))
        (setq ent (ssname ss (setq i (1- i)))
              dxf (entget ent)
        )
        (fixdxf dxf)
      )

      (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
    )
)
(princ)
)

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

本帖最后由 llsheng_73 于 2017-12-14 11:06 编辑

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

ysq101 发表于 2017-12-14 11:11:02

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


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

ysq101 发表于 2017-12-14 11:11:35

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


谢谢大师出手相助
页: [1]
查看完整版本: 关于修改多线段顶点表