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

AutoCAD坐标

请帮忙。
我需要一个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

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

(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

给你，伙计：
 

(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))
页: [1] 2
查看完整版本: AutoCAD坐标