AutoCAD坐标

cabltv1 · 发表于 2022-7-6 15:13:07

请帮忙。
我需要一个AutoCAD VBA例程，可以执行以下操作：
1）拾取现有块以获取其坐标。
2）拾取另一个块，并将第一个块的坐标放入带有标记“PT1”的拾取块的属性中。

Lee Mac · 发表于 2022-7-6 15:20:53

欢迎来到CADTutor CABLTV，希望你喜欢这里。

这个帖子可能会在VBA/AutoLISP自定义论坛中得到更多回复，看看你是否可以找一个版主帮你移动它。

但是——不要在那个论坛上重复这个帖子——让这个帖子动起来。

Lee Mac · 发表于 2022-7-6 15:27:19

实际的要求应该不会太难-我会看看我能为你做些什么

Tiger · 发表于 2022-7-6 15:31:45

你的愿望是我的命令

Cabltv-这是你需要经常做的事情还是一次性的事情？在我看来，可以通过将坐标导出到Excel和。。然后我迷路了。。。

Lee Mac · 发表于 2022-7-6 15:38:35

使用此功能，您可以一个接一个地执行以下操作：

copy


(defun c:attpt (/ pBlk dBlk ptBlk aEnt aEntLst)
 (while (and (setq pBlk (car (entsel "\nSelect Block to Retrieve Coordinates >  ")))
         (setq dBlk (car (entsel "\nSelect Destination Block >  ")))
         (= (cdr (assoc 0 (entget pBlk))) "INSERT" (cdr (assoc 0 (entget dBlk))))
         (= (cdr (assoc 66 (entget dBlk))) 1))
   (setq ptBlk (cdr (assoc 10 (entget pBlk)))
     aEnt (entnext dBlk))
   (while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
     (if (= "PT1" (cdr (assoc 2 aEntLst)))
   (progn
   (setq aEntLst (subst (cons 1 (strcat (rtos (car ptBlk) 2 2) ","
                        (rtos (cadr ptBlk) 2 2) ","
                        (rtos (caddr ptBlk) 2 2)))
                (assoc 1 aEntLst) aEntLst))
   (entmod aEntLst)))
     (setq aEnt (entnext aEnt))))
 (command "_regenall")
 (princ))

cabltv1 · 发表于 2022-7-6 15:45:02

谢谢李。
成功了！

Lee Mac · 发表于 2022-7-6 15:46:34

没问题，很高兴它对你有用

如果你还有什么问题，尽管问

cabltv1 · 发表于 2022-7-6 15:54:49

还有一件事。
它工作得很好，但我需要在拾取具有“PT1”属性的第二个块后停止该功能，而不必按escape键。

Lee Mac · 发表于 2022-7-6 15:56:48

我将对其进行修改，但您不必按Esc键，只需单击鼠标右键或按enter键即可。

Lee Mac · 发表于 2022-7-6 16:06:42

给你，伙计：

copy


(defun c:attpt (/ pBlk dBlk ptBlk aEnt aEntLst)
 (if (and (setq pBlk (car (entsel "\nSelect Block to Retrieve Coordinates >  ")))
         (setq dBlk (car (entsel "\nSelect Destination Block >  ")))
         (= (cdr (assoc 0 (entget pBlk))) "INSERT" (cdr (assoc 0 (entget dBlk))))
         (= (cdr (assoc 66 (entget dBlk))) 1))
   (progn
   (setq ptBlk (cdr (assoc 10 (entget pBlk)))
     aEnt (entnext dBlk))
   (while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
     (if (= "SIZE" (cdr (assoc 2 aEntLst)))
   (progn
   (setq aEntLst (subst (cons 1 (strcat (rtos (car ptBlk) 2 2) ","
                        (rtos (cadr ptBlk) 2 2) ","
                        (rtos (caddr ptBlk) 2 2)))
                (assoc 1 aEntLst) aEntLst))
   (entmod aEntLst)))
     (setq aEnt (entnext aEnt)))
 (command "_regenall")))
 (princ))

[编程交流] AutoCAD坐标

发表回复

精选推荐