社区 › Auto Lisp › 我需要一个Lisp程序的语言来改变关闭

antistar 发表于 2022-7-6 08:23:16

 
从第三方应用程序导入的图形。

MSasu 发表于 2022-7-6 08:27:05

然后，在这里发布一个示例图形可能会很有用-只有几个项目。

Tharwat 发表于 2022-7-6 08:30:16

我想知道为什么第一个程序对你不起作用，但无论如何试试这个。。。。。
 

(defun c:Test (/ ss i sn pt r spc vl)
(vl-load-com)
;;; Tharwat 25 . June . 2012 ;;;
(if (not acdoc)
   (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq spc (if (> (vla-get-activespace acdoc) 0)
             (vla-get-modelspace acdoc)
             (vla-get-paperspace acdoc)
         )
)
(if (setq ss (ssget "_:L" '((0 . "*POLYLINE"))))
   (progn
   (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (if (vlax-curve-isclosed (setq vl (vlax-ename->vla-object sn)))
         (progn
         (entmakex
             (list
               '(0 . "CIRCLE")
               (cons 10
                     (vlax-safearray->list
                     (vlax-variant-value
                         (vla-get-Centroid
                           (setq r
                                  (car (vlax-invoke spc 'addregion (list vl)))
                           )
                         )
                     )
                     )
               )
               '(40 . 2.0)
             )
         )
         (entdel (cdr (assoc -1 (entget sn))))
         (vla-delete r)
         )
       )
   )
   )
)
(princ)
)

antistar 发表于 2022-7-6 08:33:57

 
 
不幸的是，它没有起作用。
您可以查看附图吗？
谢谢
POLY\u CIR.dwg

Tharwat 发表于 2022-7-6 08:36:33

 
代码不起作用，因为多段线是打开的，而不是闭合的。

antistar 发表于 2022-7-6 08:41:50

 
Tharwat，我为我的错误道歉，非常感谢您的关注。
事实上，对象具有如示例中所示的LW多段线和多段线，需要在圆中转换。
如果有人知道怎么做，我将不胜感激。

Lee Mac 发表于 2022-7-6 08:43:49

请尝试以下操作：
 

(defun c:p2c ( / _vertices _vertices1 _vertices2 _pointaverage e i r s )

   (setq r 0.1) ;; Circle Radius

   (defun _vertices ( l )
       (if (eq "LWPOLYLINE" (cdr (assoc 0 l)))
         (_vertices1 l)
         (_vertices2 (entnext (cdr (assoc -1 l))))
       )
   )
   
   (defun _vertices1 ( l / p )
       (if (setq p (assoc 10 l))
         (cons (cdr p) (_vertices1 (cdr (member p l))))
       )
   )

   (defun _vertices2 ( e )
       (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
         (cons (cdr (assoc 10 (entget e))) (_vertices2 (entnext e)))
       )
   )
   
   (defun _pointaverage ( l / x )
       (setq x (length l))
       (mapcar '/ (apply 'mapcar (cons '+ l)) (list x x))
   )

   (if (setq s (ssget "_:L" '((0 . "*POLYLINE"))))
       (repeat (setq i (sslength s))
         (setq e (entget (ssname s (setq i (1- i)))))
         (if (entmake
                   (list
                      '(0 . "CIRCLE")
                     (assoc 008 e)
                     (cons010 (_pointaverage (_vertices e)))
                     (cons040 r)
                     (cond ((assoc 006 e)) ('(006 . "BYLAYER")))
                     (cond ((assoc 039 e)) ('(039 . 0.0)))
                     (cond ((assoc 062 e)) ('(062 . 256)))
                     (cond ((assoc 370 e)) ('(370 . -1)))
                     (assoc 210 e)
                     (assoc 410 e)
                   )
               )
               (entdel (cdr (assoc -1 e)))
         )
       )
   )
   (princ)
)

Lee Mac 发表于 2022-7-6 08:47:39

重复点的情况。。。
 
(defun c:p2c ( / _vertices _vertices1 _vertices2 _uniquefuzz _pointaverage e i r s )

   (setq r 0.1) ;; Circle Radius

   (defun _vertices ( l )
       (if (eq "LWPOLYLINE" (cdr (assoc 0 l)))
         (_vertices1 l)
         (_vertices2 (entnext (cdr (assoc -1 l))))
       )
   )
   
   (defun _vertices1 ( l / p )
       (if (setq p (assoc 10 l))
         (cons (cdr p) (_vertices1 (cdr (member p l))))
       )
   )

   (defun _vertices2 ( e )
       (if (eq "VERTEX" (cdr (assoc 0 (entget e))))
         (cons (cdr (assoc 10 (entget e))) (_vertices2 (entnext e)))
       )
   )

   (defun _uniquefuzz ( l f )
       (if l
         (cons (car l)
               (_uniquefuzz
                   (vl-remove-if '(lambda ( x ) (equal x (car l) f)) (cdr l))
                   f
               )
         )
       )
   )
   
   (defun _pointaverage ( l / x )
       (setq x (length l))
       (mapcar '/ (apply 'mapcar (cons '+ l)) (list x x))
   )

   (if (setq s (ssget "_:L" '((0 . "*POLYLINE"))))
       (repeat (setq i (sslength s))
         (setq e (entget (ssname s (setq i (1- i)))))
         (if (entmake
                   (list
                      '(0 . "CIRCLE")
                     (assoc 008 e)
                     (cons010 (_pointaverage (_uniquefuzz (_vertices e) 1e-))
                     (cons040 r)
                     (cond ((assoc 006 e)) ('(006 . "BYLAYER")))
                     (cond ((assoc 039 e)) ('(039 . 0.0)))
                     (cond ((assoc 062 e)) ('(062 . 256)))
                     (cond ((assoc 370 e)) ('(370 . -1)))
                     (assoc 210 e)
                     (assoc 410 e)
                   )
               )
               (entdel (cdr (assoc -1 e)))
         )
       )
   )
   (princ)
)

antistar 发表于 2022-7-6 08:52:50

 
李，
代码运行得很好。
 
非常感谢您的关注。
 
当做

查看完整版本: 我需要一个Lisp程序的语言来改变关闭