需要从x，y，z到x，y，c
李为我开发了这个例程，效果很好，但我需要更新的属性来显示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))))) 更改这两行：
（chr 32）（in2ft（cadr ePt））（chr 32“，”
（chr 32）（in2ft（caddr ePt）））
到
（chr 32）（in2ft（cadr ePt））） 工作得很有魅力！非常感谢你。
我还有一个问题。我有一个例行程序来移动一个块，然后通过在移动块后单击两次来更新坐标。除了一件事，它工作得很好。格式错误。
这是更新后的外观。。。7593.37,615.43,0.00
这就是更新后需要它的方式。。。。759'-3.37",61'-5.43",0.00
我还需要去掉z坐标（0.00）。
如果您能提供任何帮助，我将不胜感激。
(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)) 好的，李一定要睡懒觉了，我会介入的
更改：
（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”表示精度 不错，卡尔，
我看到在第一篇文章中，cabltv没有发布我编写的用于该代码的局部函数（即in2ft）。
我意识到回报是以英寸为单位的，但需要以英尺和英寸为单位。
如果
(rtos 3 2)有效，这是一个很好的解决方法-但像往常一样，我必须找到解决我所有问题的困难方法 还有一件事-cabltv，在未来，您可以使用
"code goes here" [/ code]<p> </p><p>obviously without the spaces in the second set of brackets.</p> 卡尔：谢谢你的帮助！我感谢你花时间解决我的问题。
李：非常感谢你的原始代码。当我第一次请求你的帮助时，我没有意识到要求是英尺/英寸。以后我会听从你的建议。 还有一个问题，然后我就不管你们了。
李为我创建了下面的代码，当然，它工作得很好！我需要解决一个问题，即“PT1”和“PT2”属性中的坐标在彗差之间有一个我不需要的空间。示例：xx’-xx”，xx’-xx”。
有没有一种简单的方法来消除昏迷之间的间隙？
(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)) 这将删除空格：
(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坐标-这是你想要的吗？ 此外，请记住发布子功能以及主功能，以便能够进行测试
页:
[1]
2