求优化-文本获取坐标lisp

lileiaj

麻烦请各位老师，帮我看下怎么获取文本中心点的坐标值，现有的lisp文件获取的是文字左下角的坐标值，请各位老师帮我优化下

Dea25

(defun entm(ent);返回对象外包框的中点坐标BY:Dea25
(vl-load-com)
(if (= (type ent) 'ENAME)
        (mapcar '* '(0.5 0.5 0.5) (apply '(lambda (x1 x2)(mapcar '+ x1 x2)) (acet-ent-geomextents ent)))
        nil
)
)

jun353835273

改了的       顺便改了下ssget函数

烟花丝雨

(setq zb(cdr(assoc 11 ent)))

p-3-ianlcc

测试了一下，存成dat
只能捉取text
无法捉法mtext

lileiaj

jun353835273 发表于 2023-9-8 08:26
改了的       顺便改了下ssget函数

感谢老师！

lileiaj

Dea25 发表于 2023-9-8 09:16
(defun entm(ent);返回对象外包框的中点坐标BY:Dea25
(vl-load-com)
(if (= (type ent) 'ENAME)

好的，感谢老师，我试试

lzspain

要是能按照一定的顺序提取就更好了

lileiaj

lzspain 发表于 2023-9-8 15:42
要是能按照一定的顺序提取就更好了

在优化中，还没弄好。

xyp1964

1. (defun c:wb ()
   
2.   (defun mid (s1 / p1 p9)
   
3.     (vla-getboundingbox (vlax-ename->vla-object s1) 'p1 'p9)
   
4.     (list (vlax-safearray->list p1) (vlax-safearray->list p9))
   
5.     (mapcar '(lambda (x y) (* (+ x y) 0.5))
   
6.             (vlax-safearray->list p1)
   
7.             (vlax-safearray->list p9)
   
8.     )
   
9.   )
   
10.   "将文本及坐标导出dat文件"
    
11.   (princ "\n选择需要导出的文本")
    
12.   (if (setq ss (ssget '((0 . "text"))))
    
13.     (progn
    
14.       (setq ff (OPEN (getfiled "文件保存到" "d:/" "dat" 1) "W")
    
15.             i  -1
    
16.       )
    
17.       (while (setq s1 (ssname ss (setq i (1+ i))))
    
18.         (setq nr (cdr (assoc 1 s1))
    
19.               zb (mid s1)
    
20.               x (rtos (car zb) 2 3)
    
21.               y (rtos (cadr zb) 2 3)
    
22.               z (rtos (caddr zb) 2 3)
    
23.         )
    
24.         (princ (strcat nr "," y "," x) ff)
    
25.         (princ "\n" ff)
    
26.       )
    
27.       (close ff)
    
28.       (prompt (strcat "\n共添加了" (itoa (sslength ss)) "个文本及坐标"))
    
29.     )
    
30.   )
    
31.   (princ)
    
32. )
    

(defun c:wb ()<br />   (defun mid (s1 / p1 p9)<br />     (vla-getboundingbox (vlax-ename->vla-object s1) 'p1 'p9)<br />     (list (vlax-safearray->list p1) (vlax-safearray->list p9))<br />     (mapcar '(lambda (x y) (* (+ x y) 0.5))<br />             (vlax-safearray->list p1)<br />             (vlax-safearray->list p9)<br />     )<br />   )<br />   "将文本及坐标导出dat文件"<br />   (princ "\n选择需要导出的文本")<br />   (if (setq ss (ssget '((0 . "text"))))<br />     (progn<br />       (setq ff (OPEN (getfiled "文件保存到" "d:/" "dat" 1) "W")<br />             i  -1<br />       )<br />       (while (setq s1 (ssname ss (setq i (1+ i))))<br />         (setq nr (cdr (assoc 1 s1))<br />               zb (mid s1)<br />               x (rtos (car zb) 2 3)<br />               y (rtos (cadr zb) 2 3)<br />               z (rtos (caddr zb) 2 3)<br />         )<br />         (princ (strcat nr "," y "," x) ff)<br />         (princ "\n" ff)<br />       )<br />       (close ff)<br />       (prompt (strcat "\n共添加了" (itoa (sslength ss)) "个文本及坐标"))<br />     )<br />   )<br />   (princ)<br /> )<br />