社区 › Auto Lisp › 如何将所有点更改为

Lee Mac 发表于 2022-7-5 17:31:32

FWIW，这里有另一种方法来避免计算集合中每个对象的相对点位置：
(defun c:test ( / h i l p s w x )
   (if (and (progn (initget 6) (setq w (getdist "\nSpecify x-dimension: ")))
            (progn (initget 6) (setq h (getdist "\nSpecify y-dimension: ")))
            (setq s (ssget '((0 . "POINT,CIRCLE"))))
            (setq l (list
                        (list (/ w -2) (/ h -2))
                        (list (/ w2) (/ h -2))
                        (list (/ w2) (/ h2))
                        (list (/ w -2) (/ h2))
                  )
            )
       )
       (repeat (setq i (sslength s))
         (setq p (cdr (assoc 10 (entget (ssname s (setq i (1- i)))))))
         (entmake
               (append
                  '(   (000 . "LWPOLYLINE")
                     (100 . "AcDbEntity")
                     (100 . "AcDbPolyline")
                     (090 . 4)
                     (070 . 1)
                   )
                   (mapcar '(lambda ( x ) (cons 10 (mapcar '+ p x))) l)
               )
         )
       )
   )
   (princ)
)

Lee Mac 发表于 2022-7-5 17:35:04

作为扩展，以下操作应在任何UCS构造平面中的点和圆上成功执行，并将考虑活动UCS旋转-对于点，将使用活动UCS构造平面：
(defun c:test ( / e h i l n p s v w x )
   (if (and (progn (initget 6) (setq w (getdist "\nSpecify x-dimension: ")))
            (progn (initget 6) (setq h (getdist "\nSpecify y-dimension: ")))
            (setq s (ssget '((0 . "POINT,CIRCLE"))))
            (setq l (mapcar '(lambda ( x ) (mapcar '/ (list w h) x)) '((-2 -2) (2 -2) (2 2) (-2 2)))
                  v (trans '(0 0 1) 1 0 t)
            )
       )
       (repeat (setq i (sslength s))
         (setq e (entget (ssname s (setq i (1- i))))
               p (cdr (assoc 10 e))
         )
         (if (= "POINT" (cdr (assoc 0 e)))
               (setq p (trans p 0 v) n (cons 210 v))
               (setq n (assoc 210 e))
         )
         (entmake
               (append
                  '(   (000 . "LWPOLYLINE")
                     (100 . "AcDbEntity")
                     (100 . "AcDbPolyline")
                     (090 . 4)
                     (070 . 1)
                   )
                   (list (cons 38 (caddr p)))
                   (mapcar '(lambda ( x ) (cons 10 (mapcar '+ p (trans x 1 (cdr n) t)))) l)
                   (list n)
               )
         )
       )
   )
   (princ)
)

Rain0923 发表于 2022-7-5 17:40:09

尊敬的李：，
谢谢你的分享。
这对我有好处：D
 

Lee Mac 发表于 2022-7-5 17:44:32

不客气！

CADWORKER 发表于 2022-7-5 17:48:17

你好
 
你能修改它，用三角形替换圆或点吗？三角形的两条边应该很长，三角形的底端到一半边，方向是底端或顶端的底端（两条边中的任何一条）。。
 
谢谢

Grrr 发表于 2022-7-5 17:50:56

 
为什么不为此创建一个块，然后将其插入点/圆的顶部？

查看完整版本: 如何将所有点更改为