yshf 发表于 2019-5-31 17:27
那上传你的测试图
点击的文本对象是“附注”两个字，然后复制出来的文本飞到了左上角
另外是否可以让代码执行完后就退出，不要再让我选择新的文本对象？
点击的文本对象是“附注”两个字，然后复制出来的文本飞到了左上角
另外是否可以在选完第二个点后直接退出，不要再让我选择新的文本对象？
(defun c:t2 ( / ss pt1 pt2 listInsertPoint dxf floatTextHigh strText floatRotateAngle floatScaleFactor strStyleName)
(setq ss (ssget ":S" '((0 . "TEXT"))))
(if (and (setq pt1 (getpoint "\n指定第一个点："))
(setq pt2 (getpoint pt1 "\n指定第二个点："))
)
(progn
(setq listInsertPoint (mapcar '(lambda(a b)(* 0.5 (+ a b))) pt1 pt2))
(setq dxf (entget (ssname ss 0)))
(setq floatTextHigh (assoc 40 dxf) )
(setq strText (assoc 1 dxf) )
(setq floatRotateAngle (assoc 50 dxf) )
(setq floatScaleFactor (assoc 41 dxf) )
(setq strStyleName (assoc 7 dxf) )
(entmake (list '(0 . "TEXT")
'(10 0 0 0)
(cons 11 listInsertPoint)
floatTextHigh
strText
floatRotateAngle
floatScaleFactor
strStyleName
'(72 . 1)
'(73 . 2)
'(100 . "AcDbText")
)
)
)
);if
(princ)
) 已修改，详见2#楼 yshf 发表于 2019-5-31 20:49
已修改，详见2#楼
xiang19751218 发表于 2019-5-31 20:29
(defun c:t2 ( / ss pt1 pt2 listInsertPoint dxf floatTextHigh strText floatRotateAngle floatScaleFact ...
感谢回复，不过好像不能用~就用二楼大大的代码就好啦
页:
1
[2]