motee-z 发表于 2022-7-5 23:02:01

向三维多段线添加新顶点

你好
可以在三维多段线上的任何位置添加新顶点的例程的任何帮助与拾取点的高程相同,它可以作为autocad命令使用,但如果要添加很多点,则它很长并且需要很多时间
谢谢

David Bethel 发表于 2022-7-5 23:46:36

虽然我不太理解您描述的高程场景,但这应该基于拾取点向三维多边形添加顶点:
 
 
 

(defun c:add3dv (/ p ss en ed vn vd vl tl fl)

;;;ARG -> TestPt LinePt1 LinePt2 Fuzz
;;;RET T nil
(defun is_pt_online (pt l1 l2 fz)
(and (numberp fz)
      (equal (distance l1 l2)
             (+ (distance l1 pt)
                (distance l2 pt)) fz)))

(setvar "OSMODE" (logior (getvar "OSMODE") 512))
(and (setq p (getpoint "\nSelect Point On a 3DPOLY:"))
      (setq p (trans p 1 0))
      (setq ss (ssget p '((0 . "POLYLINE")(-4 . "&")(70 . 8))))
      (= (sslength ss) 1)
      (setq en (ssname ss 0)
            ed (entget en)
            vn (entnext en)
            vd (entget vn))
      (while (= "VERTEX" (cdr (assoc 0 vd)))
             (setq vl (cons (cdr (assoc 10 vd)) vl)
                   vn (entnext vn)
                   vd (entget vn))))
(setq tl vl)
(while (> (length vl) 1)
      (setq fl (cons (car vl) fl))
      (cond ((equal p (car vl))
               (alert "Existing Vertex - Cannot Add Point"))
            ((is_pt_online p (car vl) (cadr vl) 1e-8)
               (setq fl (cons p fl))))
      (setq vl (cdr vl)))

(setq fl (cons (car vl) fl))

(if (= (length fl) (length tl))
   (alert "No Vertices Added")
   (progn
       (entdel en)
       (entmake ed)
       (foreach v fl
         (entmake (list (cons 0 "VERTEX")
                        (assoc 8 vd)
                        (cons 10 v)
                        (cons 70 32))))
      (entmake (list (cons 0 "SEQEND")(assoc 8 vd)))))
(prin1))



 
 
-大卫

motee-z 发表于 2022-7-6 00:30:22

谢谢David先生的回复,没关系,但如果我想重复添加点,我添加了(在第10行时),它关闭了3dpoly的开始和结束,这是什么原因
页: [1]
查看完整版本: 向三维多段线添加新顶点