中心画圆请高手指导下

zwq8629

在选择对象中心画圆

我想把中心圆放在图层“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

异形的中心不太好确定，楼主可以截图在哪些图形中，画圆，下面是创建图层的代码
;;;设置当前图层，没有就创建
(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

2. (defun c:csk (/ dxf10 i p0 p1 p2 pp s1 ss)
   
3.   (defun dxf10 (e / s);10组码取点
   
4.     (if        (setq s
   
5.                (mapcar 'cdr
   
6.                        (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e))
   
7.                )
   
8.         )
   
9.       (if (= 1 (length s))
   
10.         (car s)
    
11.         s
    
12.       )
    
13.     )
    
14.   )
    
15.   (setq i -1)
    
16.   (if (setq ss (ssget ":S" (list '(0 . "LWPOLYLINE"))))
    
17.     (while (and (setq s1 (ssname ss (setq i (1+ i)))))
    
18.       (setq pp (dxf10 s1)
    
19.             p1 (car pp)
    
20.             p2 (caddr pp)
    
21.       )
    
22.       (setq p0 (mapcar '(lambda (x) (* 0.5 x)) (mapcar '+ p1 p2)))
    
23.       (vla-AddCircle
    
24.         (vla-get-modelSpace
    
25.           (vla-get-ActiveDocument (vlax-get-acad-object))
    
26.         )
    
27.         (vlax-3D-point p0)
    
28.         (* 0.02 (distance p1 p2))
    
29.       )
    
30.       (if (= (tblsearch "LAYER" "CSK") nil)
    
31.         (entmake
    
32.           (list
    
33.             '(0 . "LAYER")
    
34.             '(100 . "AcDbSymbolTableRecord")
    
35.             '(100 . "AcDbLayerTableRecord")
    
36.             '(70 . 0)
    
37.             '(6 . "Continuous")
    
38.             '(62 . 2)
    
39.             (cons 2 "CSK")
    
40.           )
    
41.         )
    
42.       )
    
43.       (vla-put-layer (vlax-ename->vla-object (entlast)) "CSK")
    
44.       (entmake (list '(0 . "LINE")
    
45.                      (cons 8 "CSK")
    
46.                      (cons 10 p0)
    
47.                      (cons 11 p1)
    
48.                )
    
49.       )
    
50.     )
    
51.   )
    
52.   (princ)
    
53. )

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

zwq8629

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

哥，这里多了条线

zwq8629

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

多谢大佬，搞定了

zwq8629

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

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

zwq8629

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

andyding

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

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

戏男

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

zwq8629

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

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