求优化-文本获取坐标lisp

lileiaj · 发表于 2023-9-8 08:09:58

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

Dea25 · 发表于 2023-9-8 09:16:08

(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 · 发表于 2023-9-8 08:26:37

改了的顺便改了下ssget函数

烟花丝雨 · 发表于 2023-9-8 08:40:12

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

p-3-ianlcc · 发表于 2023-9-8 09:35:13

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

lileiaj · 发表于 2023-9-8 10:25:51

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

感谢老师！

lileiaj · 发表于 2023-9-8 10:28:20

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

好的，感谢老师，我试试

lzspain · 发表于 2023-9-8 15:42:37

本帖最后由 lzspain 于 2023-9-8 15:46 编辑

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

lileiaj · 发表于 2023-9-9 09:04:10

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

在优化中，还没弄好。

xyp1964 · 发表于 2023-9-9 09:47:57

本帖最后由 xyp1964 于 2023-9-9 09:49 编辑

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

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

账号		自动登录	找回密码
密码			注册

[讨论] 求优化-文本获取坐标lisp

本帖子中包含更多资源

本帖子中包含更多资源