矩形中心点 ，加中心切割线

ninja37

想编一LISP程序，
实现如下功能：框选矩形，计算出矩形（矩形是多义线，矩形是横竖着的，也可能是斜的）的中心点。生成一个点（图层3），还生成一根直线（图层4），直线从矩形的中心点为起点，终点可以为矩形的任意角落。求高手指教，谢谢！

xj6019

(defun c:NM (/ dxf10 i p0 p1 p2 pp s1 ss)
        (defun dxf10 (e / s)  ;10组码取点
                (if (setq s
                                        (mapcar 'cdr
                                                (vl-remove-if-not '(lambda (x) (= (car x) 10))(entget e))
                                        )
                                )
                        (if (= 1 (length s))(car s)s)
                )
        )
  (setq i -1)
  (if (setq ss (ssget ":S"(list '(0 . "LWPOLYLINE"))))
    (while (and(setq s1 (ssname ss (setq i (1+ i)))))               
                        (setq pp(dxf10 s1)
                                p1(car pp)
                                p2(caddr pp)
                        )
                        (setq p0(mapcar '(lambda(x)(* 0.5 x)) (mapcar '+ p1 p2)))
                        (vla-AddCircle (vla-get-modelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))(vlax-3D-point p0) (* 0.02 (distance p1 p2)))
                        (vla-put-layer (vlax-ename->vla-object (entlast)) "图层3")
                        (entmake (list '(0 . "LINE") (cons 8  "图层4")(cons 10 p0)  (cons 11 p1)  ))
                )
  )
        (princ)
)

ninja37

xj6019 发表于 2022-7-21 00:13
(defun c:NM (/ dxf10 i p0 p1 p2 pp s1 ss)
        (defun dxf10 (e / s)  ;10组码取点
             ...

谢谢大师帮助。能不能帮修改一下(vla-AddCircle (vla-get-modelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))(vlax-3D-point p0) (* 0.02 (distance p1 p2)))

这句是生成一个圆，能不能改成生成一个点图元 就可以了   点图元在  图层3

xj6019

ninja37 发表于 2022-7-27 18:37
谢谢大师帮助。能不能帮修改一下(vla-AddCircle (vla-get-modelSpace (vla-get-ActiveDocument (vlax-get ...

(vla-AddPoint (vla-get-modelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))(vlax-3D-point p0) )

夜曲11110

感谢楼主，正在寻找这个