社区 › Auto Lisp › 在所有Autocad en上放置点

4DCES 发表于 2022-7-6 08:20:01

在所有Autocad en上放置点

大家好
 
我发现这个代码是早些时候张贴在这个论坛上，我想知道是否有可能改变它。我需要能够在某些Autocad图元上放置点。
例如
线条的起点和终点。
多段线的每个顶点。
弧的中间和末端。
圆心。
和块的插入点。
我已经设法更改了代码，使其适用于线、圆和块
但似乎无法更改圆弧。有人能给我指出正确的方向吗。
谢谢
 
谢谢
 
; 在多段线顶点处绘制点
; 和（M）个文本插入点
;;; mfuccaro@hotmail.com 09.06.2003
;
（defun c:pts（/ss i首先删除零）
（setvar“CMDECHO”0）
（命令“UNDO”“begin”）
（setq ss（ssget）i 0）
（重复（sslength ss）
（setq elist（entget（ssname ss i））
零（cdr（assoc 0 elist）））
（如果（或（=零“TEXT”）（=零“MTEXT”）（=零“LWPOLYLINE”）（=零“圆”）（=零“线”））
（当elist
（setq first（car elist）elist（cdr elist））
（if（=10（车辆优先））（命令“点”（cdr优先））
))
（setq i（1+i））
)
（命令“undo”“end”）
（setvar“CMDECHO”1）
（普林斯）
)

marko_ribar 发表于 2022-7-6 08:27:32

在这里，试试这个，但它是预测没有弧的LWPOLYLINE。。。弧作为独立的对象，根据需要在起点、终点和中点编程，直线也会重新编程以考虑起点和终点。。。
 

; Draw POINTs at POLYLINE vertexes
; and at (M)TEXT insertion points
;;; mfuccaro@hotmail.com 09.06.2003
;
(defun c:pts ( / ss i elist zero first second third fourth )
(setvar "CMDECHO" 0)
(command "UNDO" "begin")
(setq ss (ssget) i 0)
(repeat (sslength ss)
(setq elist (entget (ssname ss i))
zero (cdr (assoc 0 elist)))
(cond
((OR (= zero "TEXT") (= zero "MTEXT") (= zero "CIRCLE"))
(progn
(setq first (assoc 10 elist))
(command "POINT" (cdr first))
))
((= zero "LWPOLYLINE")
(progn
(while elist
(setq first (car elist) elist (cdr elist))
(if (= (car first) 10) (command "POINT" (cdr first)))
)
))
((= zero "LINE")
(progn
(setq first (assoc 10 elist) second (assoc 11 elist))
(command "POINT" (cdr first))
(command "POINT" (cdr second))
))
((= zero "ARC")
(progn
(setq first (assoc 10 elist) second (assoc 40 elist) third (assoc 50 elist) fourth (assoc 51 elist))
(command "POINT" (polar (cdr first) (cdr third) (cdr second)))
(command "POINT" (polar (cdr first) (cdr fourth) (cdr second)))
(command "POINT" (polar (cdr first) (/ (+ (cdr third) (cdr fourth)) 2.0) (cdr second)))
))
)
(setq i (1+ i))
)
(command "undo" "end")
(setvar "CMDECHO" 1)
(princ)
)
M.R。

David Bethel 发表于 2022-7-6 08:33:11

或者像这样：
 

(defun c:vpoints (/ ss en ed et vl el pl ce ra sa ea ia i c)

(setvar "PDMODE" 3)

(defun massoc (key alist / x nlist)
   (foreach x alist
   (if (eq key (car x))
         (setq nlist (cons (cdr x) nlist))))
   (reverse nlist))

(and (setq ss (ssget '((0 . "3DFACE,ARC,CIRCLE,INSERT,LINE,LWPOLYLINE,SOLID,TRACE")))))
      (while (setq en (ssname ss 0))
             (setq ed (entget en)
                   et (cdr (assoc 0 ed)))
             (cond ((= et "LWPOLYLINE")
                  (setq vl (massoc 10 ed)
                        el (cdr (assoc 38 ed)))
                  (foreach p vl
                     (setq pl (cons (trans (list (car p) (cadr p) el) en 0) pl))))
                   ((= et "ARC")
                  (setq ce (cdr (assoc 10 ed))
                        ra (cdr (assoc 40 ed))
                        sa (cdr (assoc 50 ed))
                        ea (cdr (assoc 51 ed))
                        ia (if (> sa ea)
                                 (+ (- (* 2 pi) sa) ea)
                                 (- ea sa))
                        pl (cons (trans (polar ce sa ra) en 0) pl)
                        pl (cons (trans (polar ce ea ra) en 0) pl)
                        pl (cons (trans (polar ce (+ sa (* ia 0.5)) ra) en 0) pl)))
                (T
                  (foreach g '(10 11 12 13)
                  (and (assoc g ed)
                         (setq pl (cons (trans (cdr (assoc g ed)) en 0) pl))))))
             (ssdel en ss))
      (setq i 0 c 0)
      (foreach p pl
          (and (not (member p (cdr (member p pl))))
               (setq c (1+ c))
               (entmake (list (cons 0 "POINT")
                              (cons 10 p))))
          (setq i (1+ i)
               pl (cdr pl)))

(princ (strcat (rtos i 2 0) " Atom Point List vs "
                (rtos c 2 0) " Unique POINTs"))
(prin1))

可以操作过滤器列表以删除面或实体等。
 
-大卫

elfert 发表于 2022-7-6 08:38:26

美好的但是，如果我想要Autocad mechanical 2011工具集库项的插入点中的一个点，这可能吗？

David Bethel 发表于 2022-7-6 08:48:17

 
它们到底是什么-大卫

Lee Mac 发表于 2022-7-6 08:54:05

另一种方法是使用曲线函数：
 
(defun c:points ( / e i j l s x )

   (defun _point ( p )
       (entmake (list '(0 . "POINT") (cons 10 p)))
   )
   (if (setq s (ssget '((0 . "*POLYLINE,LINE,ARC,CIRCLE,INSERT"))))
       (repeat (setq i (sslength s))
         (setq e (ssname s (setq i (1- i)))
               l (entget e)
         )
         (cond
               (   (eq "LINE" (setq x (cdr (assoc 0 l))))
                   (_point (cdr (assoc 10 l)))
                   (_point (cdr (assoc 11 l)))
               )
               (   (wcmatch x "*POLYLINE")
                   (repeat (setq j (1+ (fix (vlax-curve-getendparam e))))
                     (_point (vlax-curve-getpointatparam e (setq j (1- j))))
                     (if (not (equal '(0 0 0) (vlax-curve-getsecondderiv e j)))
                           (_point (vlax-curve-getpointatparam e (+ j 0.5)))
                     )
                   )
               )
               (   (eq "CIRCLE" x)
                   (_point (trans (cdr (assoc 10 l)) e 0))
               )
               (   (eq "ARC" x)
                   (_point (vlax-curve-getstartpoint e))
                   (_point (vlax-curve-getendpoint   e))
                   (_point
                     (vlax-curve-getpointatparam e
                           (/ (+ (vlax-curve-getstartparam e) (vlax-curve-getendparam e)) 2.0)
                     )
                   )
               )
               (   t
                   (_point (trans (cdr (assoc 10 l)) e 0))
               )
         )
       )
   )
   (princ)
)
(vl-load-com) (princ)

elfert 发表于 2022-7-6 08:57:52

 
它们就像普通孔、通孔、螺纹孔和Auto cad mechanical可以在俯视图中制作的孔。在这个孔的中心，我想要一个层中的点，因为等离子切割程序可以读取这些点，这就是为什么我要问这个问题。
 
埃尔弗特

David Bethel 发表于 2022-7-6 09:02:43

 
问题是它们是什么类型的Autocad图元？插入、代理实体、三维实体。LIST命令可能会启发我们-大卫

elfert 发表于 2022-7-6 09:11:11

 
我只能说它们在AutoCad mechanical中被称为STDPART2D。比如，如果你做一个圈，然后把它列出来，它叫做圈。
 
埃尔弗特

SLW210 发表于 2022-7-6 09:17:23

4DCES，
 
请阅读代码发布指南并编辑您的帖子。

查看完整版本: 在所有Autocad en上放置点