社区 › AutoCAD工具插件 › 中心画圆请高手指导下

zwq8629 发表于 2023-6-27 16:27:33

中心画圆请高手指导下

在选择对象中心画圆

我想把中心圆放在图层“CSK”上（没有则新建图层）颜色：黄色


请大佬看下要怎么改









(defun c:csk (/ 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)
)

hhh454 发表于 2023-6-27 17:07:53

异形的中心不太好确定，楼主可以截图在哪些图形中，画圆，下面是创建图层的代码
;;;设置当前图层，没有就创建
(defun slay ()
(setvar "cmdecho" 0) ;_关闭命令提示
(if (= nil (tblsearch "layer" "csk"))
    (progn (command "-layer" "new" "csk" "c" "2" "csk" ""))
)
(command "-layer" "s" "csk" "")
(setvar "cmdecho" 1) ;_打开命令提示
)
(slay);;;启用函数

andyding 发表于 2023-6-27 17:01:18

(defun c:csk (/ 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))
      )
      (if (= (tblsearch "LAYER" "CSK") nil)
        (entmake
          (list
          '(0 . "LAYER")
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbLayerTableRecord")
          '(70 . 0)
          '(6 . "Continuous")
          '(62 . 2)
          (cons 2 "CSK")
          )
        )
      )
      (vla-put-layer (vlax-ename->vla-object (entlast)) "CSK")
      (entmake (list '(0 . "LINE")
                     (cons 8 "CSK")
                     (cons 10 p0)
                     (cons 11 p1)
             )
      )
    )
)
(princ)
)

zwq8629 发表于 2023-6-27 17:09:25

andyding 发表于 2023-6-27 17:01





哥，这里多了条线

zwq8629 发表于 2023-6-27 17:23:02

本帖最后由 zwq8629 于 2023-6-27 17:24 编辑

hhh454 发表于 2023-6-27 17:07
异形的中心不太好确定，楼主可以截图在哪些图形中，画圆，下面是创建图层的代码
;;;设置当前图层，没有就 ...
多谢大佬，搞定了

zwq8629 发表于 2023-6-27 17:26:45

hhh454 发表于 2023-6-27 17:07
异形的中心不太好确定，楼主可以截图在哪些图形中，画圆，下面是创建图层的代码
;;;设置当前图层，没有就 ...

还有一个问题，画的中心圆没有在新建的图层上

zwq8629 发表于 2023-6-27 18:17:22

另加了一行函数搞定了，再次感谢两位大师

andyding 发表于 2023-6-28 23:06:48

zwq8629 发表于 2023-6-27 18:17
另加了一行函数搞定了，再次感谢两位大师

把以下删掉就行了
      (entmake (list '(0 . "LINE")
                     (cons 8 "CSK")
                     (cons 10 p0)
                     (cons 11 p1)
               )
      )

戏男 发表于 2023-6-29 09:15:19

穿丝孔可以用这个来画方便

zwq8629 发表于 2023-7-5 14:07:07

andyding 发表于 2023-6-28 23:06
把以下删掉就行了
      (entmake (list '(0 . "LINE")
                     (cons 8 "CSK")


大师，还有个问题麻烦你，这个只能画四边形的，其他多边型画出的圆不在中心

查看完整版本: 中心画圆请高手指导下