文字随旋转插入
我有以下代码，将绘制一个带有X的框，并在左上角插入文本，上面写着“过时的日期用户名”。到目前为止，除了我更换UCS外，一切都很顺利。该框没有问题，但文字是相对于WCS插入的，而不是当前的。我搜索了这个网站，找到了一个用“trans”功能解决这个问题的方法。不幸的是，这并没有解决文本相对于WCS仍然旋转的问题。不知道该从这里走到哪里。任何帮助都会很棒！(defun C:test2 (/)
(setq #BoxP1# (getpoint "\nSpecify first corner point: ")
#BoxP2# (getcorner "\nSpecify other corner point: " #BoxP1#)
#BoxP3# (list (Car #BoxP2#) (cadr #BoxP1#) 0)
#BoxP4# (list (Car #BoxP1#) (cadr #BoxP2#) 0)
#BoxTextHeight# (/ (* (abs (- (car #BoxP2#) (car #BoxP1#))) 0.125) 0.875)
#TextLayer# (getvar "CLAYER")
#BoxWidth# (abs (- (car #BoxP2#) (car #BoxP1#)))
#textheight# (/ #BoxWidth# 30)
#TextDate# (rtos (getvar "CDATE") 2 4)
#TextDateParsed# (strcat (substr #TextDate# 5 2)"/"(substr #TextDate# 7 2)"/"(substr #TextDate# 3 2))
#TextPt# (list (min (car #BoxP1#) (car #BoxP3#) (car #BoxP3#) (car #BoxP4#))
(+ (max (cadr #BoxP1#) (cadr #BoxP2#) (cadr #BoxP3#) (cadr #BoxP4#)) (/ #textheight# 3))
);end #TextPt#
#UserName# (getvar "LOGINNAME")
#UserInitials# (strcase (strcat (substr #UserName# 1 1)(substr #UserName# (+ 2 (vl-string-position (ascii ".") #UserName#)) 1))) ;This might fail for you since our office comps use "first.last" format.
);end setq
(vl-cmdf "_.rectangle" #BoxP1# #BoxP2#)
(vl-cmdf "_.line" #BoxP1# #BoxP2# "")
(vl-cmdf "_.line" #BoxP3# #BoxP4# "")
(entmake (list '(0 . "TEXT")
(cons 10 (trans #TextPt# 1 0))
(cons 40 #textheight#)
(cons 1 (strcat "OBSOLETE " #TextDateParsed# " -" #UserInitials#))
'(50 . 0.0)
'(7 . "Standard")
'(71 . 0)
'(72 . 0)
'(73 . 0)
) ;_end list
) ;_end entmake
(princ)
);end defun guitarguy1685，
由于您正在创建文本实体，您将拥有
计算旋转值并将其分配给（cons 50旋转）
ymg公司 你知道如何检查ucs是当前的吗？ 系统变量“UCSXDIR”
ymg公司 如果希望与不平行于WCS平面的UCS平面兼容，还需要转换相对于文字/多段线图元的OCS的坐标和文字旋转，例如：
(defun c:test3 ( / getuser p1 p2 p3 p4 q1 q3 th zv )
(defun getuser ( s / p )
(if (setq p (vl-string-position 46 s))
(strcat (substr s 1 1) (substr s (+ p 2) 1))
s
)
)
(if (and (setq q1 (getpoint "\nSpecify 1st corner: "))
(setq q3 ((if (zerop (getvar 'worlducs)) getpoint getcorner) q1 "\nSpecify 2nd corner: "))
)
(progn
(setq p1 (mapcar 'min q1 q3)
p3 (mapcar 'max q1 q3)
p2 (list (car p3) (cadr p1) (caddr p1))
p4 (list (car p1) (cadr p3) (caddr p1))
th (/ (- (car p2) (carp1)) 7.0)
zv (trans '(0 0 1) 1 0 t) ;; UCS extrusion vector
)
(entmake
(append
'( (000 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
(090 . 4)
(070 . 1)
)
(list (cons 038 (caddr (trans p1 1 zv))))
(mapcar '(lambda ( x ) (cons 10 (trans x 1 zv))) (list p1 p2 p3 p4))
(list (cons 210 zv))
)
)
(entmake (list '(0 . "LINE") (cons 10 (trans p1 1 0)) (cons 11 (trans p3 1 0))))
(entmake (list '(0 . "LINE") (cons 10 (trans p2 1 0)) (cons 11 (trans p4 1 0))))
(entmake
(list
'(0 . "TEXT")
'(7 . "Standard")
(cons 010 (trans (list (car p1) (+ (cadr p3) (/ th 3.0)) (caddr p1)) 1 zv))
(cons 040 th)
(cons 050 (angle '(0.0 0.0) (trans (getvar 'ucsxdir) 0 zv t)))
(cons 001 (strcase (strcat "OBSOLETE " (menucmd "m=$(edtime,0,ddmonyy)") " - " (getuser (getvar 'loginname)))))
(cons 210 zv)
)
)
)
)
(princ)
) 你谦逊地对我说：“我不配！我不配！”
现在我必须试着理解你所做的一切，非常感谢。这个网站接受捐款吗？因为这些年来它对我非常有用。
*编辑*刚找到你的网站
我还将对这个程序进行研究。这里有一些非常好的东西。 你真是太好了guitarguy-如果你对代码有任何问题，请随时提问！
页:
[1]