Question

求大神帮忙写一个CAD里面LSP命令，要求如下

命令：PEDIT--选取对象--E--S--确定--N--确定--N--确定--G--确定。
大概目的是实现多段线从一个顶点到第三个顶点拉直，从而将中间的第二个点去掉，最终达到多段线中间的顶点减少，方便图案的编辑。

Answer 1

;去掉多段线节点
(defun c:tes ( / &kw1 ent n obj p1 ss1 ss5 x)
 (vl-load-com)
 (if (and (setq ent (entsel "\n请选择多段线对象"))
     (setq ent (car ent))
     (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
   )
  (progn;;1
   (sssetfirst nil (ssadd ent))
   (setq obj (vlax-ename->vla-object ent))
   (setq ss5 (apply 'append (mapcar 'cdr (vl-remove-if '(lambda (X) (/= 10 (car x))) (entget ent)))))
   (setq n (- (length ss5) 1) ss5 (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 n)) ss5));双精度表
   (setq ss5 (list ss5))
   (while (setq p1 (x1808262))
    (if (= (type p1) 'STR)
     (progn;;2-1
      (if (> (length ss5) 1) (setq ss5 (cdr ss5)) )
      (setq ss1 (car ss5))
      (vla-put-Coordinates obj ss1)
     );progn;2-1
     (if (setq ss1 (x1808261 ent obj p1)) (setq ss5 (cons ss1 ss5)) )
    );if;2
   );while
   (sssetfirst nil)
  );progn;1
 );if
 (princ)
);复制到记事本，以【.lsp】后缀命名，CAD命令【appload】加载

;修改多段线节点
(defun x1808261 (ent obj p1 / ent n obj p1 ss1 x y)
 (setq ss1 (mapcar 'cdr (vl-remove-if '(lambda (X) (/= 10 (car x))) (entget ent))) n 0)
 (setq ss1 (mapcar '(lambda (x) (list (setq n (1+ n)) (distance p1 x) x)) ss1))
 (setq ss1 (apply 'append (mapcar 'caddr (vl-sort (cdr (vl-sort ss1 '(lambda (x y) (< (cadr x) (cadr y))))) '(lambda (x y) (< (car x) (car y)))))))
 (setq n (- (length ss1) 1) ss1 (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 n)) ss1));双精度表
 (vla-put-Coordinates obj ss1)
 (if (>= n 1) ss1 nil)
)

(defun x1808262 ()
 (initget "U")
 (getpoint "\n请选择要删除的点[返回上一步(U)]")
)