标记对象点

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

根据需要更改所有设置：

copy


(defun C:demo(/ en  obj points ss tp xyz)
(defun get3dverices (obj / coords  param 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 p  points
      (setq xyz (strcat "E "
   (rtos (car p) 2 3)
   "[url="file://\\PN"]\\PN[/url] "
   (rtos (cadr p) 2 3)
   "[url="file://\\PEL"]\\PEL[/url]. "
   (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，
别担心，你的代码做得很好。
如何将引线的大小设置为适合当前尺寸标注，因为在代码中只有箭头和更改的文本。

copy

 
(command "._leader"  "_non"  p  "_non"  (setq tp (polar p (/ pi 4) (* 10 (getvar "textsize"))))  "_non"  (polar tp 0 (getvar "textsize"))  ""  xyz  ""))

[编程交流] 标记对象点

发表回复

精选推荐