各位大侠帮忙看下这个对齐的代码，他现在的顺序是先Y方向，然后X方向，能不能改一...

664571221 · 发表于 2024-12-19 17:50:59

各位大侠帮忙看下这个对齐的代码，他现在的顺序是先Y方向，然后X方向，能不能改一下，先X方向，然后Y方向

被风吹走的灰尘 · 发表于 2024-12-19 21:50:32

修改了，你看看

muai2010 · 发表于 2024-12-19 22:02:46

被风吹走的灰尘发表于 2024-12-19 21:50
修改了，你看看

可惜带转角的文字没办法实现转角对齐，还是x y常规那样对齐

xyp1964 · 发表于 2024-12-19 22:05:22

;; 更改文字为左对齐
(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)
)

;; 更改文字为左对齐 
(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) 
)

664571221 · 发表于 2024-12-20 09:17:05

被风吹走的灰尘发表于 2024-12-19 21:50
修改了，你看看

大哥顺序还是不对的

煮茗 · 发表于 2024-12-20 09:26:34

原代码这两句改全一下。

(initget "s h")
(setq m (getkword "[竖向对齐(s)/横向对齐(h)]"))

你的原图纸先h横向对齐，再s竖向对齐就可以达到目的了。

664571221 · 发表于 2024-12-21 12:05:18

咏君修改;---------------------------------------------------------------------;
;已完成，勿动(-_-!)
;根据参数返回点列表按某一坐标轴排序，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 "

" '((0 . "TEXT"))) (getpoint "\n指定对齐点：") (getreal"\n指定间距:"))
(pzj:dqts (ssget "

" '((0 . "TEXT"))) (getpoint "\n指定对齐点：") (getreal"\n指定间距:"))
)
(princ)
)
;---------------------------------------------------------------------;

账号		自动登录	找回密码
密码			注册

[提问] 各位大侠帮忙看下这个对齐的代码，他现在的顺序是先Y方向，然后X方向，能不能改一...

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源