[求助]将字符串各自对齐到矩形的右下边的角位
<p>申请一个CAD2004能用的LSP程序，</p><p>每个矩形框中有各有一个字符串，框选多个矩形与字符串后，将字符串各自对齐到矩形的右下边的角位置，字符串距角边150。</p><p>谢谢。</p><p>好像上传不了附件，请到临时邮箱下载测试文件，里面表达比较清楚：</p><p><a href="mailto:leng_cad@163.com">leng_cad@163.com</a></p><p>密码：lengcad</p><p></p><p>晓东有一个，据说可用于CAD2008，CAD2004测试不成功。</p> 仅对测试文件有效。(defun c:tt ()
(setvar "CMDECHO" 0)
(setq oldos (getvar "OSMODE"))
(if (progn (princ "\n选择矩形框 :")
(setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))))) (progn
(setq i 0)
(setvar "OSMODE" 0)
(repeat (sslength ss)
(setq ent (entget(ssname ss i))
i (1+ i)
plst (list))
(foreach x ent (if (= (car x) 10) (setq plst (cons (cdr x) plst))))
(if (setq ss1 (ssget "WP" plst '((0 . "TEXT")))) (progn
(setq pt (polar
(polar (caddr plst) (angle (caddr plst) (last plst)) 150)
(angle (caddr plst) (cadr plst)) 150))
(setq ent (entget (ssname ss1 0)))
(setq temp (cadr (textbox (list (assoc 1 ent)))))
(setq ptt (cdr(assoc 11 ent)))
(command ".MOVE" (ssname ss1 0) "" ptt pt)
))
)
(setvar "OSMODE" oldos)
))
(setvar "CMDECHO" 1)
(princ)
)
本帖最后由 作者 于 2010-4-8 10:03:41 编辑 <br /><br /> <p><font face="Verdana" color="#da2549"><strong>见到ZZXXQQ的回复就激动</strong><font color="#000000"></font></font></p><p>CAD2004测试OK</p><p>感谢老大</p><p>今天对一个比较大的图形文件处理，文本并不是全部对齐到右下边的角位，四个角位都可能都是文本对齐的位置。请问能固定对齐到右下边的角位吗？</p><p>附上发现问题的图形的图形测试文件</p> 附件可以上传并可以正常下载,楼上<strong>实例图形文件</strong>文本并不是全部对齐到右下边的角位。 <p>我的意思是对齐到右下边的那个角的位置，2楼程序好像是对齐到矩形的第二个节点位置，因为矩形是用PL线连成的，并不是用REC命令画成的，第二个节点位置并不一定是右下边的角位，所以各个角位都成了字符串可能对齐的位置，能改成固定对齐到右下边的角位吗？</p><p>3楼有测试文件，若不能下载，请到临时邮箱下载，谢谢。<br/><a href="mailto:leng_cad@163.com">leng_cad@163.com</a></p><p>密码：lengcad<br/></p> 本帖最后由 作者 于 2010-4-9 17:27:04 编辑
在网巴没法下载图，写了程序未经调试。
;;选择矩形框，框内文字自动对齐框的右下角点 明经 ZZXXQQ 2010.4.8
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (progn (princ "\n选择矩形框 :")
(setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1) (90 . 4))))) (progn
(setq i 0)
(repeat (sslength ss)
(setq ent (entget(ssname ss i))
i (1+ i)
ptl (list))
(foreach x ent (if (= (car x) 10) (setq ptl (cons (cdr x) ptl))))
(setq ptl (reverse ptl))
(if (setq ss1 (ssget "WP" ptl '((0 . "TEXT")))) (progn
(setq pt1 (list (max (caar ptl) (caadr ptl) (caaddr ptl) (car(last ptl)))
(min (cadar ptl) (cadadr ptl) (cadr(nth 2 ptl)) (cadr(last ptl))))
)
(setq j 1 k 0)
(repeat (1- (length ptl))
(if (> (distance (nth k ptl) pt1) (distance (nth j ptl) pt1)) (setq k j))
(setq j (1+ j))
)
(setq pt2 (nth k ptl)
pt3 (nth (if (= k 0) 3 (1- k)) ptl)
pt4 (nth (if (= k 3) 0 (1+ k)) ptl)
pt (polar (polar pt2 (angle pt2 pt3) 150) (angle pt2 pt4) 150))
(setq ent (entget (ssname ss1 0)))
(setq ptt (cdr(assoc 11 ent)))
(command ".MOVE" (ssname ss1 0) "" ptt pt)
))
)
))
(princ)
)
谢谢版主，CAD2004测试，还没全部对齐到右下边的角位，有些对齐到了右下角位但距离没达到150的要求。<br/>红色数字为节点编号，已做成块，不影响程序结果。 上图的DWG文件 6楼程序调试通过，再试试。 <p>谢谢版主，经CAD2004测试全都对齐到右下边的角位了，字符距右下边的距离各为150好象框选时无效，但单选时有效。</p><p></p>
页:
[1]
2