查找文本和中间点
你好我不是Lisp程序的家庭，你能帮我做以下事情吗。
我想写一个lisp来做以下事情
1.我将提供一个文本，lisp应该从图形文件（我的意思是从当前打开的图形）中找到该文本。
2.如果找到文本，则应提供文本的中点。
提前谢谢。
马哈德凡 不确定为什么没有答案在dwg中很容易找到文本
唯一的问题是，中点可能会因字体类型的不同而略有不同，但当设置为mid pt时，您可能可以使用“insertionpoint”来返回该点。
本例将打印出所有文本的插入点。
(setq ss (ssget (list (cons 0 "Text"))))
(setq len (sslength ss))
(setq x 0)
(repeat len
(setq en1 (ssname ss x))
(setq el1 (entget en1))
(setq v1 (atof (cdr (assoc 10 el1))))
(princ v1)
)
我现在不在工作，我相信有人会发布完整的解决方案。 试试这个代码，希望对你有帮助
它将为您提供文本的插入点
(defun c:Test (/ string sset c ent insp point)
;;Ganesh Shetty
(if (setq string (strcase (getstring t "\nEnter String:: ")))
(progn
(if (setq sset (ssget "x"(list (cons 0 "TEXT,MTEXT"))))
(progn
(repeat (setq c (sslength sset))
(setq ent (entget (ssname sset (setq c (1- c)))))
(if (equal (strcase (cdr (assoc 1 ent))) string)
(progn
(if (or (= "MTEXT" (cdr (assoc 0 ent)))
(and
(zerop (cdr (assoc 72 ent)))
(zerop (cdr (assoc 73 ent)))
)
)
(setq insp (cdr (assoc 10 ent)))
(setq insp (cdr (assoc 11 ent)))
)
(setq point (strcat "E-" (rtos (car insp)) "," "N-" (rtos (cadr insp))))
(princ "\n")
(princ point)
)
)
)
)
)
)
)
(princ)) 非常感谢BIGAL&gS7，我会试试这个，然后再给你回复。
当做
马哈德凡 试试这个。
;;; mid point of text or mtext ;;;
;;; JDiala 09-23-2013 ;;;
(vl-load-com)
(defun c:test (/ s ss pl)
(if
(setq ss (ssget "_X" (list (cons 0 "TEXT,MTEXT") (cons 1 (setq s (getstring t "\nEnter String :"))))))
(progn
(repeat (setq i (sslength ss))
(vla-GetBoundingBox
(vlax-ename->vla-object
(ssname ss (setq i (1- i)))
) 'p1 'p2
)
(setq pl
(cons
(mapcar
(function
(lambda (a b) (/ (+ a b) 2.))
)
(vlax-safearray->list p1)
(vlax-safearray->list p2))
pl
)
)
)
(princ pl)
)
(princ (strcat "\nNothing found with \"" s " \" string on the drawing!"))
)
(princ)
) 另一个
(defun c:Test2(/ s sset ent bpt ang tb pt1 mpoint)
;Gs7
(if (setq s (strcase (getstring t "\nEnter String::")))
(progn
(if (setq sset (ssget "_x" (list (cons 0 "TEXT,MTEXT"))))
(progn
(repeat (setq c (sslength sset))
(setq ent (entget (ssname sset (setq c(1- c)))))
(if (equal (strcase (cdr (assoc 1 ent))) s)
(progn
(setq Bpt (cdr (assoc 10 ent)))
(setq ang (cdr (assoc 50 ent)))
(setq Tb(cadr (textbox (list (assoc -1 ent)))))
(setq pt1 (polar bpt ang (/ (car tb) 2.0)))
(setq mpoint (polar pt1 (+ ang (/ pi 2.0)) (/ (cadr tb) 2.0)))
(princ "\n")
(princ mpoint)
)
)
)
)
)
)
)
(princ))
非常感谢您的回复。
你们所付出的一切都是和弦一起工作。但它不适用于附图。这是因为圆（示例AD1）和圆的名称是单个对象。所以当我们尝试用AD1搜索时，它说没有找到文本。
在附图中，有一些圆圈，其名称在右侧和左侧，中间有一些数值。我们想用lisp做的就是找到给定名称的圆心（例如，如果给定文本AD1，它必须找到相应圆的中点）点1和数字（位于中间）点2的圆心，并从点1到点2绘制一条线。
现在，我面临一个问题：为给定的名称找到圆的中点（在X和Y两个方向上）和给定数值的中点（在X和Y两个方向上）。请帮我做同样的事。
拉斯特。图纸
这是因为你在第一篇文章中提到了“文本”，你仍然用文本像圆圈一样调用它，因为你的信息是一个属性对象 非常感谢GS7。
我会试着给你回复。
-马哈德凡 Mahadevan请试用Bellow Lisp程序
如果你有什么问题，请告诉我
在运行程序之前，请从图形中删除不需要的对象
;;Ganesh Shetty
;;27.09.2013
(defun c:blkl(/ string ss space n e p1 p2)
(vl-load-com)
(if
(and
(setq string (getstring "\nEnter String::"))
(setq ss (ssget "X" '((0 . "INSERT") (66 . 1))))
)
(progn
(setq space (vla-get-modelspace
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(setq n (substr string 3 6))
(repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
(foreach b
(Vlax-SafeArray->List
(variant-value
(vla-getattributes e)
)
)
(cond
((equal (strcase(vla-get-Textstring b)) (strcase String))
(setq p1 (vla-get-textalignmentpoint b))
)
((equal (vla-get-textstring b) n)
(setq p2 (vla-get-Textalignmentpoint b))
)
)
)
)
(vla-addline space p1 p2)
)
)
(princ))
页:
[1]
2