社区 › Auto Lisp › 在多点中绘制圆

emil-m 发表于 2022-7-5 16:49:32

在多点中绘制圆

你好
我想制作一个脚本，在多个点上绘制圆。这些点是在autocad的扩展中自动生成的。所有点都在同一层中。图中大约有200到1000个点。
我的第一个问题是找到一个画圆圈的突击队员，所有的点都有基点。
有人知道适合我的命令吗？
 
 
当做
埃米尔

paulmcz 发表于 2022-7-5 16:58:50

这就是我用的。
 
(defun c:ic (/ a b c r d n p d1 d2 e1 cl oerr osn)

(setq osn (getvar "osmode"))
(setvar "cmdecho" 0)

(setq cl (getvar "clayer"))
(if c
   ()
   (setq c 1.0)
)
(princ "\n Circle diameter < ")
(princ c)
(princ " > ? ")
(setq b (getdist))
(if (= b nil)
   (setq b c)
   (setq c b)
)
(setq r (/ b 2))
(princ "\n Select nodes ")
(setq a (ssget '((0 . "POINT"))))
(setq d (sslength a))
(setq d1 d)
(repeat d
   (setq d2 (1- d1))
   (setq n (ssname a d2))
   (setq e1 (entget n))
   (setq p (cdr (assoc 10 e1)))
   (entmake (list (cons 0 "CIRCLE")
           (cons 6 "BYLAYER")
           (cons 8 cl)
           (cons 10 p)
           (cons 40 r)
           (cons 210 (list 0.0 0.0 1.0))
   )
   )

   (entdel n)
   (setq d1 d2)
)
(setvar "osmode" osn)
(princ)
)

BIGAL 发表于 2022-7-5 17:01:17

也许代码稍微简化一下
 

(setq d (sslength a))
(setq d1 d)
(repeat d
   (setq d2 (1- d1))
   (setq n (ssname a d2))
   (setq e1 (entget n))

(repeat (setq d2 (sslength a)))
    (setq e1 (entget (ssname a (setq d2 (- d2 1)))))

satishrajdev 发表于 2022-7-5 17:09:30

另一个
(defun c:test (/ a b i)
(if (and (setq a (ssget '((0 . "point"))))
   (setq b (getdist "\nSpecify Circle Radius : "))
   )
   (repeat (setq i (sslength a))
   (entmakex
(list (cons 0 "CIRCLE")
      (assoc 10 (entget (ssname a (setq i (1- i)))))
      (cons 40 b)
)
   )
   )
)
(princ)
)

Lee Mac 发表于 2022-7-5 17:15:05

@Satish，注意：
(cons 10 (cdr (assoc 10 <list>))) == (assoc 10 <list>)

Grrr 发表于 2022-7-5 17:21:14

我记得有人写了一个算法，用于在范围内间隔圆（不确定是否是Marko）。
现在似乎找不到。

satishrajdev 发表于 2022-7-5 17:27:38

 
谢谢你，先生。我需要更加关注这个
 
顺便说一句，我已经更新了代码。

emil-m 发表于 2022-7-5 17:28:12

非常感谢。
它工作得很好！
 
 

Lee Mac 发表于 2022-7-5 17:41:05

FWIW，这是另一个版本，它将保留点的原始属性，并将考虑在任何UCS平面中构造的点：
(defun c:p2c ( / c i r s x )
   (if (and (setq s (ssget '((0 . "POINT"))))
         (progn
               (initget 6)
               (setq r (getdist "\nSpecify circle radius: "))
         )
       )
       (repeat (setq i (sslength s))
         (setq x (reverse (entget (ssname s (setq i (1- i)))))
               c (assoc 10 x)
         )
         (entmake
               (subst '(0 . "CIRCLE") '(0 . "POINT")
                   (subst (cons 10 (trans (cdr c) 0 (cdr (assoc 210 x)))) c
                     (reverse
                           (cons (cons 40 r)
                               (vl-remove-if '(lambda ( x ) (member (car x) '(50 102 360))) x)
                           )
                     )
                   )
               )
         )
       )
   )
   (princ)
)

Grrr 发表于 2022-7-5 17:48:45

这是一些有趣的列表操作李！
我也会删除GCs-15和100（以防万一）。尽管entmake/x似乎忽略了它们：
_$ (entmake (list (cons 0 "POINT") (cons 5 "MyHandle") (cons 100 "AcDbLWPolyline") (cons 62 1) (cons 10 (getpoint))))
((0 . "POINT") (5 . "MyHandle") (100 . "AcDbLWPolyline") (62 . 1) (10 -38.7621 156.008 0.0))
_$ (entget (entlast))
((-1 . <Entity name: 7ff678604cc0>) (0 . "POINT") (330 . <Entity name: 7ff6786039f0>) (5 . "24C") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 1) (100 . "AcDbPoint") (10 -38.7621 156.008 0.0) (210 0.0 0.0 1.0) (50 . 0.0))
_$

查看完整版本: 在多点中绘制圆