Pither Rukka 发表于 2022-7-6 10:07:06

标记对象点

我找到了一个代码来标记拾取点，该代码有一些修改：
 
我想修改它以显示选定对象（例如3dpoly）的所有拾取点。
标记。lsp

Pither Rukka 发表于 2022-7-6 10:24:30

对不起，这是代码
 

(defun c:labeling (/p1 p2 x y z ptcoord textloc)
(while
   (setq p1 (getpoint "\nPick Point: "))
   (setq p2 (getpoint p1 "\nPick Point Direction: "))
   (setq textloc (getpoint p2 "\nPick Label Location: "))
   (setq x (rtos (car p1)))
   (setq y (rtos (cadr p1)))
   (setq z (rtos (caddr p1)))
   (setq x (strcat "E " x))
   (setq y (strcat "N " y))
   (setq z (strcat "EL. " z))
   (command "qleader" p1 p2 textloc "" x y z "")
)
)

 
我想修改它以显示选定对象（例如3dpoly）的所有点。
有人能帮我吗。。。。

BIGAL 发表于 2022-7-6 10:33:14

这里有很多关于查找多段线顶点的内容，然后您只需为“qleader”添加代码，唯一的区别是为标签答案设置一个角度，可能还有一个预定义的偏移量。
 
现在我想起来了，我确信李·麦克已经完成了对普林的搜索？

BIGAL 发表于 2022-7-6 10:40:15

这是我找到的一个
 
http://www.cadtutor.net/forum/showthread.php?41117-Label-Point-Z-Value&高亮显示=标签
 
再搜索一点

Pither Rukka 发表于 2022-7-6 10:53:08

谢谢Bigal，但您的参考仅选取像我的代码一样的点，而不使用箭头。
 
我需要的代码选择对象有超过1点（直线，多段线，三维多段线等…）然后显示点的所有坐标（xyz）。

fixo 发表于 2022-7-6 11:02:05

 
根据需要更改所有设置：

(defun C:demo(/ enobj points ss tp xyz)

(defun get3dverices (obj / coordsparam pt)
(cond ((eq (vla-get-objectname obj) "AcDbLine")
(setq coords (list (vlax-curve-getstartpoint obj)(vlax-curve-getendpoint obj))))
((wcmatch (vla-get-objectname obj)
       "AcDb2dPolyline,AcDb3dPolyline")
(setq param
(cond((eq (vlax-curve-isclosed obj) :vlax-true)
    (fix (vlax-curve-getendparam obj)))
   ((fix (1+ (vlax-curve-getendparam obj))))
   )
)
(while (setq pt (vlax-curve-getpointatparam obj (setq param (1- param ))))
   (setq coords (cons pt coords))
))
((eq (vla-get-objectname obj)
       "AcDbPolyline")
(setq param
(cond((eq (vlax-curve-isclosed obj) :vlax-true)
    (fix (vlax-curve-getendparam obj)))
   ((fix (1+ (vlax-curve-getendparam obj))))
   )
)
(while (setq pt (vlax-curve-getpointatparam obj (setq param (1- param ))))
   (setq coords (cons pt coords))
)
(setq coords (mapcar (function (lambda(x)(list (car x)(cadr x)(vla-get-elevation obj)))) coords)))
)
)

(if
(setq ss (ssget ":L" (list (cons 0 "LINE,*POLYLINE"))))
(while (setq en (ssname ss 0))
    (setq points (GET3DVERICES (vlax-ename->vla-object en)))
    (foreach ppoints
      (setq xyz (strcat "E "
   (rtos (car p) 2 3)
   "\\PN "
   (rtos (cadr p) 2 3)
   "\\PEL. "
   (rtos (caddr p) 2 3)))
      (command "._leader"
"_non"
p
"_non"
(setq tp (polar p (/ pi 4) (* 10 (getvar "textsize"))))
"_non"
(polar tp 0 (getvar "textsize"))
""
xyz
""))
    (ssdel en ss)))
(princ)
)

 
抱歉，几乎没有测试

Pither Rukka 发表于 2022-7-6 11:13:05

谢谢Fixo，
别担心，你的代码做得很好。
如何将引线的大小设置为适合当前尺寸标注，因为在代码中只有箭头和更改的文本。
 

(command "._leader""_non"p"_non"(setq tp (polar p (/ pi 4) (* 10 (getvar "textsize"))))"_non"(polar tp 0 (getvar "textsize"))""xyz""))
页: [1]
查看完整版本: 标记对象点