各位大侠帮忙看下这个对齐的代码，他现在的顺序是先Y方向，然后X方向，能不能改一...
各位大侠帮忙看下这个对齐的代码，他现在的顺序是先Y方向，然后X方向，能不能改一下，先X方向，然后Y方向修改了，你看看 被风吹走的灰尘 发表于 2024-12-19 21:50
修改了，你看看
可惜带转角的文字没办法实现转角对齐，还是x y常规那样对齐 ;; 更改文字为左对齐
(defun Just-Left (ent) (entmod (subst (cons 72 0) (assoc 72 ent) ent)))
;; 文字横向对齐
(defun dq-hor (ss p0 dd / i boxpt lst d0 s1)
(setq i -1)
(repeat (sslength ss)
(setq s1 (ssname ss (setq i (1+ i))))
(Just-Left (entget s1)) ;文字改为左对齐
(setq boxpt (textbox (entget s1))
lst (cons (list
s1
(cdr (assoc 10 (entget s1)))
(1+ (fix (- (nth 0 (nth 1 boxpt)) (nth 0 (nth 0 boxpt)))))
)
lst
) ;构建((图元名1 对齐点1 字长1) (图元名2 对齐点2 字长2)...)列表
lst (vl-sort lst '(lambda (a b) (< (caadr a) (caadr b))));x向从左到右排序
)
)
(setq d0 0)
(foreach a lst
(if (or (= dd nil)(= dd 0))
(vla-move (vlax-ename->vla-object (nth 0 a))
(vlax-3d-point (nth 1 a))
(vlax-3d-point
(list (car (nth 1 a)) (cadr p0) (caddr (nth 1 a)))
)
)
(progn
(vla-move (vlax-ename->vla-object (nth 0 a))
(vlax-3d-point (nth 1 a))
(vlax-3d-point
(list (+ (car p0) d0) (cadr p0) (caddr p0))
)
)
(setq d0 (+ d0 (nth 2 a) dd))
)
)
)
(princ)
)
;; 文字纵向对齐
(defun dq-ver (ss p0 dd / i boxpt lst d0 s1)
(setq i -1)
(repeat (sslength ss)
(setq s1 (ssname ss (setq i (1+ i))))
(Just-Left (entget s1)) ;文字改为左对齐
(setq boxpt (textbox (entget s1))
lst (cons (list
s1
(cdr (assoc 10 (entget s1)))
(cdr (assoc 40 (entget s1)))
)
lst
) ;构建((图元名1 对齐点1 字高1) (图元名2 对齐点2 字高2)...)列表
lst (vl-sort lst '(lambda (a b) (> (cadadr a) (cadadr b))));y向从上到下排序
)
)
(setq d0 0)
(foreach a lst
(if (or (= dd nil)(= dd 0))
(vla-move (vlax-ename->vla-object (nth 0 a))
(vlax-3d-point (nth 1 a))
(vlax-3d-point
(list (car p0) (cadr (nth 1 a)) (caddr (nth 1 a)))
)
)
(progn
(vla-move (vlax-ename->vla-object (nth 0 a))
(vlax-3d-point (nth 1 a))
(vlax-3d-point
(list (car p0) (- (cadr p0) d0) (caddr p0))
)
)
(setq d0 (+ d0 dd))
)
)
)
)
;; 执行函数
(defun c:dq ()
(or kw (setq kw "2"))
(or dd (setq dd 450))
(setq kw (Ukword 1 "1 2" "[竖向对齐(1)/横向对齐(2)]" kw)
dd (Udist 1 "" "间距<输入或鼠标直接量取>" dd nil)
)
(while (and (setq ss (ssget '((0 . "TEXT"))))
(setq p0 (getpoint "\n指定对齐点: "))
)
(if (= kw "1")
(dq-ver ss p0 dd)
(dq-hor ss p0 dd)
)
)
(princ)
) 被风吹走的灰尘 发表于 2024-12-19 21:50
修改了，你看看
大哥顺序还是不对的 原代码这两句改全一下。
(initget "s h")
(setq m (getkword "[竖向对齐(s)/横向对齐(h)]"))
你的原图纸先h横向对齐，再s竖向对齐就可以达到目的了。
咏君修改;---------------------------------------------------------------------;
;已完成，勿动(-_-!)
;根据参数返回点列表按某一坐标轴排序，ordor=1为降序，=0为升序
(defun pzj:sort(ptlst axis ordor / tmp)
(setq tmp
(cond
((= axis "x") (vl-sort ptlst '(lambda(a b) (< (car a) (car b)))))
((= axis "y") (vl-sort ptlst '(lambda(a b) (< (cadr a) (cadr b)))))
((= axis "z") (vl-sort ptlst '(lambda(a b) (< (caddr a) (caddr b)))))
)
)
(if (= ordor 1)
(reverse tmp)
tmp
)
)
;---------------------------------------------------------------------;
;更改文字为左对齐
(defun pzj:chalignCur(ent)
(if (not (= (assoc 72 ent) 0))
(setq ent (entmod (subst (cons 72 0) (assoc 72 ent) ent)))
)
(princ)
)
;---------------------------------------------------------------------;
;文字横向对齐
(defun pzj:dqth(ss dqpt space / i boxpt lst sph)
(setq i 0)
(repeat (sslength ss)
(pzj:chalignCur (entget (ssname ss i)));文字改为左对齐
(setq
boxpt (textbox (entget (ssname ss i)))
lst (cons (list
(ssname ss i)
(cdr (assoc 10 (entget (ssname ss i))))
(1+ (fix (- (nth 0 (nth 1 boxpt)) (nth 0 (nth 0 boxpt)))))
)
lst
);构建((图元名1 对齐点1 字长1) (图元名2 对齐点2 字长2)...)列表
lst (vl-sort lst '(lambda(a b) (< (nth 0 (nth 1 a)) (nth 0 (nth 1 b)))));((图元名1 对齐点1 字长1) (图元名2 对齐点2 字长2)...)列表按x轴排序，升序
)
(setq i (1+ i))
)
(setq sph 0)
(foreach each lst
(if (= space nil)
(vla-move (vlax-ename->vla-object (nth 0 each)) (vlax-3d-point (nth 1 each)) (vlax-3d-point (list (car (nth 1 each)) (cadr dqpt) (caddr (nth 1 each)))))
(progn
(vla-move (vlax-ename->vla-object (nth 0 each)) (vlax-3d-point (nth 1 each)) (vlax-3d-point (list (+ (car dqpt) sph) (cadr dqpt) (caddr dqpt))))
(setq sph (+ (+ (nth 2 each) space) sph))
)
)
)
(princ)
)
;---------------------------------------------------------------------;
;文字纵向对齐
(defun pzj:dqts(ss dqpt space / i boxpt lst spz)
(setq i 0)
(repeat (sslength ss)
(pzj:chalignCur (entget (ssname ss i)));文字改为左对齐
(setq
boxpt (textbox (entget (ssname ss i)))
lst (cons (list
(ssname ss i)
(cdr (assoc 10 (entget (ssname ss i))))
(cdr (assoc 40 (entget (ssname ss i))))
)
lst
);构建((图元名1 对齐点1 字高1) (图元名2 对齐点2 字高2)...)列表
lst (vl-sort lst '(lambda(a b) (if (equal (nth 0 (nth 1 a)) (nth 0 (nth 1 b))100)(> (nth 1 (nth 1 a)) (nth 1 (nth 1 b)))(< (nth 0 (nth 1 a)) (nth 0 (nth 1 b))))));先按x轴小到大排序容差调整这里(nth 0 (nth 1 b))100)
;lst (mapcar '(lambda(x)(if))lst)
;lst (vl-sort lst '(lambda(a b) (> (nth 1 (nth 1 a)) (nth 1 (nth 1 b)))));((图元名1 对齐点1 字高1) (图元名2 对齐点2 字高2)...)列表按轴排序，升序(x轴m=0、y轴m=1、z轴m=2)
)
(setq i (1+ i))
)
(setq spz 0)
(foreach each lst
(if (= space nil)
(vla-move (vlax-ename->vla-object (nth 0 each)) (vlax-3d-point (nth 1 each)) (vlax-3d-point (list (car dqpt) (cadr (nth 1 each)) (caddr (nth 1 each)))))
(progn
(vla-move (vlax-ename->vla-object (nth 0 each)) (vlax-3d-point (nth 1 each)) (vlax-3d-point (list (car dqpt) (- (cadr dqpt) spz) (caddr dqpt))))
(setq spz (+ (+ (nth 2 each) space) spz))
)
)
)
)
;---------------------------------------------------------------------;
;执行函数
(vl-load-com)
(defun c:dq (/ m)
(initget "s h")
(setq m (getkword "[竖向对齐(s)/横向对齐(h)]"))
(if (= m "s")
(pzj:dqth (ssget ":L" '((0 . "TEXT"))) (getpoint "\n指定对齐点：") (getreal"\n指定间距:"))
(pzj:dqts (ssget ":L" '((0 . "TEXT"))) (getpoint "\n指定对齐点：") (getreal"\n指定间距:"))
)
(princ)
)
;---------------------------------------------------------------------;
页:
[1]