需要从x，y，z到x，y，c

cabltv1 · 发表于 2022-7-6 15:11:51

李为我开发了这个例程，效果很好，但我需要更新的属性来显示x，y坐标。该例程给出x、y、z坐标。有人能帮忙吗！

(defun lcoord (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)
(vl-load-com)
(if (and (setq lEnt (car (entsel "\nSelect Line, Polyline, LWPolyline, Spline or Arc to fill out the PT1 and PT2 attributes of the 
Footage block > ")))
(member (cdr (assoc 0 (entget lEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC"))
(setq bEnt (car (entsel "\nSelect Destination Block > ")))
(= (cdr (assoc 0 (entget bEnt))) "INSERT")
(= (cdr (assoc 66 (entget bEnt))) 1))
(progn
(setq vEnt (vlax-ename->vla-object lEnt)
sPt (vlax-curve-getStartPoint vEnt)
ePt (vlax-curve-getEndPoint vEnt)
aEnt (entnext bEnt))
(while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
(cond ((= "PT1" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1 (strcat (in2ft (car sPt)) (chr 32) ","
(chr 32) (in2ft (cadr sPt)) (chr 32) ","
(chr 32) (in2ft (caddr sPt))))
(assoc 1 aEntLst) aEntLst))
(entmod aEntLst))
((= "PT2" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1 (strcat (in2ft (car ePt)) (chr 32) ","
(chr 32) (in2ft (cadr ePt)) (chr 32) ","
(chr 32) (in2ft (caddr ePt))))
(assoc 1 aEntLst) aEntLst))
(entmod aEntLst)))
(setq aEnt (entnext aEnt)))))

CarlB · 发表于 2022-7-6 15:16:26

更改这两行：

（chr 32）（in2ft（cadr ePt））（chr 32“，”
（chr 32）（in2ft（caddr ePt）））

到

（chr 32）（in2ft（cadr ePt）））

cabltv1 · 发表于 2022-7-6 15:20:19

工作得很有魅力！非常感谢你。

我还有一个问题。我有一个例行程序来移动一个块，然后通过在移动块后单击两次来更新坐标。除了一件事，它工作得很好。格式错误。
这是更新后的外观。。。7593.37,615.43,0.00
这就是更新后需要它的方式。。。。759'-3.37",61'-5.43",0.00
我还需要去掉z坐标（0.00）。
如果您能提供任何帮助，我将不胜感激。

copy

(defun c:moveupdate_coord (/ pBlk dBlk ptBlk aEnt aEntLst)
(princ "\nMove Block into place ")
(command "move" pause "" pause pause "") 
(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 (= "COORD" (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")))
(command "vbarun" "twcstartend")
(princ))

CarlB · 发表于 2022-7-6 15:27:39

好的，李一定要睡懒觉了，我会介入的
更改：

（setq aEntLst（subst（cons 1（strcat（rtos（car ptBlk）2 2）”，”
（rtos（cadr ptBlk）2 2“，”
（rtos（caddr ptBlk）2 2）

到

（setq aEntLst（subst（cons 1（strcat（rtos（car ptBlk）3 2）”，”
（rtos（cadr ptBlk）3 2）

“3”表示工程单位，“2”表示精度

Lee Mac · 发表于 2022-7-6 15:30:29

不错，卡尔，

我看到在第一篇文章中，cabltv没有发布我编写的用于该代码的局部函数（即in2ft）。

我意识到回报是以英寸为单位的，但需要以英尺和英寸为单位。

如果

copy


(rtos [real] 3 2)

有效，这是一个很好的解决方法-但像往常一样，我必须找到解决我所有问题的困难方法

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

还有一件事-cabltv，在未来，您可以使用

copy

 [/b][color=Red][i]"code goes here"[/i][/color] [b][/ code][/b]<p> </p><p>obviously without the spaces in the second set of brackets.</p>

cabltv1 · 发表于 2022-7-6 15:37:37

卡尔：谢谢你的帮助！我感谢你花时间解决我的问题。
李：非常感谢你的原始代码。当我第一次请求你的帮助时，我没有意识到要求是英尺/英寸。以后我会听从你的建议。

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

还有一个问题，然后我就不管你们了。
李为我创建了下面的代码，当然，它工作得很好！我需要解决一个问题，即“PT1”和“PT2”属性中的坐标在彗差之间有一个我不需要的空间。示例：xx’-xx”，xx’-xx”。
有没有一种简单的方法来消除昏迷之间的间隙？

copy

(defun lcoord (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)
(command "pickbox" "8")
(vl-load-com)
(if (and (setq lEnt (car (entsel "\nSelect Line, Polyline, LWPolyline, Spline or Arc to fill out the PT1 and PT2 attributes of the 
Footage block > ")))
(member (cdr (assoc 0 (entget lEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC"))
(setq bEnt (car (entsel "\nSelect Destination Block > ")))
(= (cdr (assoc 0 (entget bEnt))) "INSERT")
(= (cdr (assoc 66 (entget bEnt))) 1))
(progn
(setq vEnt (vlax-ename->vla-object lEnt)
sPt (vlax-curve-getStartPoint vEnt)
ePt (vlax-curve-getEndPoint vEnt)
aEnt (entnext bEnt))
(while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
(cond ((= "PT1" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1 (strcat (in2ft (car sPt)) (chr 32) ","
; (chr 32) (in2ft (cadr sPt)) (chr 32) ","
; (chr 32) (in2ft (caddr sPt))))
(chr 32) (in2ft (cadr ePt))))
(assoc 1 aEntLst) aEntLst))
(entmod aEntLst))
((= "PT2" (cdr (assoc 2 aEntLst)))
(setq aEntLst (subst (cons 1 (strcat (in2ft (car ePt)) (chr 32) ","
; (chr 32) (in2ft (cadr ePt)) (chr 32) ","
; (chr 32) (in2ft (caddr ePt))))
(chr 32) (in2ft (cadr ePt))))
(assoc 1 aEntLst) aEntLst))
(entmod aEntLst)))
(setq aEnt (entnext aEnt)))))
(command "pickbox" "4")
(command "vbarun" "twcstartend")
(princ))

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

这将删除空格：

copy


(defun lcoord  (/ lEnt bEnt vEnt sPt ePt aEnt aEntLst)
 (command "pickbox" "8")
 (vl-load-com)
 (if (and (setq lEnt
         (car
           (entsel
             "\nSelect Line, Polyline, LWPolyline, Spline or Arc to fill out the PT1 and PT2 attributes of the 
Footage block > "     )))
      (member (cdr (assoc 0 (entget lEnt))) '("LINE" "POLYLINE" "LWPOLYLINE" "SPLINE" "ARC"))
      (setq bEnt (car (entsel "\nSelect Destination Block > ")))
      (= (cdr (assoc 0 (entget bEnt))) "INSERT")
      (= (cdr (assoc 66 (entget bEnt))) 1))
   (progn
     (setq vEnt (vlax-ename->vla-object lEnt)
       sPt     (vlax-curve-getStartPoint vEnt)
       ePt     (vlax-curve-getEndPoint vEnt)
       aEnt (entnext bEnt))
     (while (/= "SEQEND" (cdr (assoc 0 (setq aEntLst (entget aEnt)))))
   (cond ((= "PT1" (cdr (assoc 2 aEntLst)))
          (setq aEntLst (subst (cons 1
                     (strcat (in2ft (car sPt))
 ; (chr 32)
                         ","
 ; (chr 32) (in2ft (cadr sPt)) (chr 32) ","
 ; (chr 32) (in2ft (caddr sPt))))
 ; (chr 32)
                         (in2ft (cadr ePt))))
                   (assoc 1 aEntLst)
                   aEntLst))
          (entmod aEntLst))
         ((= "PT2" (cdr (assoc 2 aEntLst)))
          (setq aEntLst (subst (cons 1
                     (strcat (in2ft (car ePt))
 ; (chr 32)
                         ","
 ; (chr 32) (in2ft (cadr ePt)) (chr 32) ","
 ; (chr 32) (in2ft (caddr ePt))))
 ; (chr 32)
                         (in2ft (cadr ePt))))
                   (assoc 1 aEntLst)
                   aEntLst))
          (entmod aEntLst)))
   (setq aEnt (entnext aEnt)))))
 (command "pickbox" "4")
 (command "vbarun" "twcstartend")
 (princ))

顺便问一下，你知道对于属性标记PT1，它被改变的方式意味着你得到起点的x坐标和端点的y坐标-这是你想要的吗？

Lee Mac · 发表于 2022-7-6 15:51:41

此外，请记住发布子功能以及主功能，以便能够进行测试

[编程交流] 需要从x，y，z到x，y，c

发表回复

精选推荐