靠近文本实体的点绘制
我寻找一个可以解决以下任务的例程：1-我选择一组文本实体（在本例中为数字）
2-然后在1的位置附近画一个点
3-最后，例程必须能够复制其他文本字符串中的点，保持步骤2中定义的相同密切关系
附上一张图纸以便更好地理解
坦克求救！
cadtutor\u测试点。图纸 试试这个
(defun c:txtpt (/ txt1 txtpt pt ss i ptsz ang dist ip pt1 pt2 pt3 pt4)
(setq txt1(progn (princ "Pick First M/Text Object")
(ssget "_+.:E:S" '((0 . "*TEXT")))
)
txtpt (cdr (assoc 10 (entget (ssname txt1 0))))
pt (getpoint txtpt "\nSelect loction of point")
ss (progn (princ "Select All M/Text Objects")
(ssget '((0 . "*TEXT")))
)
i 0
ptsz(getreal "\nHow large should the point be?")
ang
(angle txtpt pt)
dist
(distance txtpt pt)
)
(while (< i (sslength ss))
(setq ip(polar
(cdr (assoc 10 (entget (ssname ss i))))
ang
dist
)
pt1 (polar ip (/ pi 2) (/ ptsz 2))
pt2 (polar ip (* pi 1.5) (/ ptsz 2))
pt3 (polar ip 0 (/ ptsz 2))
pt4 (polar ip pi (/ ptsz 2))
)
(command "line" pt1 pt2 "")
(command "line" pt3 pt4 "")
(command "circle" ip (/ ptsz 4))
(setq i (1+ i))
)
)
就是这样。但是，没有必要像我的示例中那样绘制符号。我的意图是将其解释为一个观点。我只想画一个简单的点实体。
我感谢你的更新。 我认为这种方式解决了我想要的。
(defun c:txtpt (/ txt1 txtpt pt ss i ptsz ang dist ip)
(setq txt1(progn (princ "Pick First M/Text Object")
(ssget "_+.:E:S" '((0 . "*TEXT")))
)
txtpt (cdr (assoc 10 (entget (ssname txt1 0))))
pt (getpoint txtpt "\nSelect loction of point")
ss (progn (princ "Select All M/Text Objects")
(ssget '((0 . "*TEXT")))
)
i 0
ang
(angle txtpt pt)
dist
(distance txtpt pt)
)
(while (< i (sslength ss))
(setq ip(polar
(cdr (assoc 10 (entget (ssname ss i))))
ang
dist
)
)
(command "point" ip)
(setq i (1+ i))
)
) (command "point" "_non" ip) pBe，
坦克！ 尝试
(defun c:Test (/ *error* c s n sn e aa ab ac)
;; Tharwat 23.05.2014 ;;
(defun *error* (msg)
(command "_.ucs" "_w")
(if c (setvar 'cmdecho c))
(if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
(princ msg)
(princ (strcat "Error : < ** " msg " ** >"))
)
)
(if (zerop (getvar 'PDMODE))
(setvar 'PDMODE 34)
)
(setq c (getvar 'cmdecho))
(setvar 'cmdecho 0)
(if (setq s (ssget '((0 . "TEXT"))))
(repeat (setq n (sslength s))
(setq sn (ssname s (setq n (1- n))))
(setq e (textbox (list
(cons -1 sn)
)
)
)
(command "_.ucs" "Object" sn)
(setq aa (car e)
ab (cadr e)
ac (list (car ab) (cadr aa))
)
(command "_.point"
"_non"
(list (car ac)
(- (cadr ac) (/ (cdr (assoc 40 (entget sn))) 2.))
)
)
)
)
(command "_.ucs" "_w")
(setvar 'cmdecho c)
(princ)
)
塔尔瓦特，
坦克！
我很欣赏这项工作。一如既往，完美。
这是一个有趣的选择，也解决了我的需要。
然而，我更喜欢这个线程中已经提供的解决方案，因为它允许每个文本字符串的设置点位置。
我所附的图纸中显示的点的位置只是一个示例。
其主要思想是可以预定义点相对于文本字符串的位置。
很高兴听到这个消息。
没问题，我只是想让生活尽可能地轻松。
祝你好运 以下是完成任务的另一种方法：
上述内容将说明选择中每个文本对象的不同位置、旋转、宽度、高度和方向，并在所有UCS和视图设置下正确执行。
页:
[1]
2