对象对齐程序，求高手完善。

hnlgy

日常工作中经常需要将一些图形对象对齐，而AutoCAD缺没有提供这样的工具，在论坛里一番搜索之后发现明总的一个小程序比较适合自己，可惜的是只有水平方向对齐，没有垂直方向对齐的功能，（明总有一个VBA的程序是支持的，但我一直无法运行,工作环境win764位、AutoCad2008 32位+天河PCCAD2011），自己折腾了半天也没搞明白.请论坛里的高手们出手完善，谢谢！

;;对象对齐程序
;;原作者 明经论坛郑立楷
(defun c:WQHL ()
  (Princ "将所选对象按指定坐标靠左水平对齐")
  (setq DQfx "HL")
  (process DQfx)
  (princ)
)

(defun c:WQHM ()
  (Princ "将所选对象按指定坐标居中水平对齐")
  (setq DQfx "HM")
  (process DQfx)
  (princ)
)

(defun c:WQHR ()
  (Princ "将所选对象按指定坐标靠右水平对齐")
  (setq DQfx "HR")
  (process DQfx)
  (princ)
)
(defun c:WQVT ()
  (Princ "将所选对象按指定坐标靠上垂直对齐")
  (setq DQfx "VT")
  (process DQfx)
  (princ)
)

(defun c:WQVM ()
  (Princ "将所选对象按指定坐标居中垂直对齐")
  (setq DQfx "VM")
  (process DQfx)
  (princ)
)

(defun c:WQVD ()
  (Princ "将所选对象按指定坐标靠下垂直对齐")
  (setq DQfx "VD")
  (process DQfx)
  (princ)
)
(defun process (amode   /     apnt      apnt_x apnt_y
  count   objname   vlaxobj   MinPoint MaxPoint
  minext   maxext    ext_l     ext_r ext_m
  tpnt
        )
  (setq oldcmdecho (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq selobjs (ssget))
  (if (or (not selobjs) (= (sslength selobjs) 1))
    (princ "\n你必须选定两个或两个以上的对象")
  )
  (initget 1)
  (setq apnt (getpoint "\n选择对齐点："))
  (setq apnt_x (car apnt)
apnt_y (cadr apnt)
  )
  (vl-load-com)
  (setq count 0)
  (repeat (sslength selobjs)
    (setq objname (ssname selobjs count))
    (setq vlaxobj (vlax-ename->vla-object objname))
    (setq MinPoint (vlax-make-variant))
    (setq MaxPoint (vlax-make-variant))
    (vla-GetBoundingBox vlaxobj 'MinPoint 'MaxPoint)
    (setq minext (vlax-safearray->list MinPoint))
    (setq maxext (vlax-safearray->list MaxPoint))
    (setq ext_l (car minext))
    (setq ext_r (car maxext))
    (setq ext_m (+ (/ (abs (- ext_l ext_r)) 2) ext_l))
    (cond
      ((= amode "HL")
       (setq tpnt (list ext_l apnt_y))
      )
      ((= amode "HM")
       (setq tpnt (list ext_m apnt_y))
      )
      ((= amode "HR")
       (setq tpnt (list ext_r apnt_y))
      )
      ((= amode "VT")
       ;;(setq tpnt (list ext_l apnt_y))
      )
      ((= amode "VM")
       ;;(setq tpnt (list ext_m apnt_y))
      )
      ((= amode "VD")
       ;;(setq tpnt (list ext_r apnt_y))
      )
    )
    (if tpnt
      (command "_move" objname "" "non" tpnt "non" apnt)
    )
    (setq count (1+ count))
  )
  (setvar "cmdecho" oldcmdecho)
)

tianyi1230

明经论坛上有相关插件，我奉献一个小萝卜头的早期作品，谢谢原作者，

hnlgy

感谢楼上的回复，不过不是我所需要的工具。我的设想是做个像VBA窗体设计工具栏一样的形式，做出左对齐、右对齐、居中对齐，顶端对齐，中间对齐，底端对齐六个按钮分别调用WQHL (),WQHM()................

工具栏已经做好了。

xiabin68

好耍，，，，

ZZXXQQ

;主函数改了下，加上了对话框。

1. (defun process (amode / apnt apnt_x apnt_y count objname vlaxobj MinPoint MaxPoint
   
2.                         minext maxext ext_l ext_r ext_m ext_vt ext_vd ext_vm tpnt)
   
3. (setq oldcmdecho (getvar "cmdecho"))
   
4. (setvar "cmdecho" 0)
   
5. (setq selobjs (ssget))
   
6. (if (or (not selobjs) (= (sslength selobjs) 1))
   
7.   (princ "\n你必须选定两个或两个以上的对象")
   
8. )
   
9. (initget 1)
   
10. (setq apnt (getpoint "\n选择对齐点："))
    
11. (setq apnt_x (car apnt)
    
12.        apnt_y (cadr apnt))
    
13. (vl-load-com)
    
14. (setq count 0)
    
15. (repeat (sslength selobjs)
    
16.   (setq objname (ssname selobjs count))
    
17.   (setq vlaxobj (vlax-ename->vla-object objname))
    
18.   (setq MinPoint (vlax-make-variant))
    
19.   (setq MaxPoint (vlax-make-variant))
    
20.   (vla-GetBoundingBox vlaxobj 'MinPoint 'MaxPoint)
    
21.   (setq minext (vlax-safearray->list MinPoint))
    
22.   (setq maxext (vlax-safearray->list MaxPoint))
    
23.   (setq ext_l (car minext))
    
24.   (setq ext_r (car maxext))
    
25.   (setq ext_m (+ (/ (abs (- ext_l ext_r)) 2) ext_l))
    
26.   (setq ext_vd (cadr minext))
    
27.   (setq ext_vt (cadr maxext))
    
28.   (setq ext_vm (+ (/ (abs (- ext_vt ext_vd)) 2) ext_vd))
    
29.   (cond
    
30.    ((= amode "HL") (setq tpnt (list ext_l apnt_y)))
    
31.    ((= amode "HM") (setq tpnt (list ext_m apnt_y)))
    
32.    ((= amode "HR") (setq tpnt (list ext_r apnt_y)))
    
33.    ((= amode "VT") (setq tpnt (list apnt_x ext_vt)))
    
34.    ((= amode "VM") (setq tpnt (list apnt_x ext_vm)))
    
35.    ((= amode "VD") (setq tpnt (list apnt_x ext_vd)))
    
36.   )
    
37.   (if tpnt (command "_move" objname "" "non" tpnt "non" apnt))
    
38.   (setq count (1+ count))
    
39. )
    
40. (setvar "cmdecho" oldcmdecho)
    
41. )
    
42. (defun c:dq ()
    
43. (setq fp (open "dq.dcl" "w"))
    
44. (foreach x
    
45.   '("dq:dialog{\n"
    
46. " label=\"对齐物体 2013\";\n"
    
47. " :row{\n"
    
48. "  :button{label=\" 左对齐 \";key=\"hl\";allow_accept=true;}\n"
    
49. "  :button{label=\"水平居中\";key=\"hm\";allow_accept=true;}\n"
    
50. "  :button{label=\" 右对齐 \";key=\"hr\";allow_accept=true;}\n"
    
51. " }\n"
    
52. " :row{\n"
    
53. "  :button{label=\" 上对齐 \";key=\"vt\";allow_accept=true;}\n"
    
54. "  :button{label=\"垂直居中\";key=\"vm\";allow_accept=true;}\n"
    
55. "  :button{label=\" 下对齐 \";key=\"vd\";allow_accept=true;}\n"
    
56. " }\n"
    
57. " cancel_button;\n"
    
58. "}\n"
    
59. )
    
60. (princ x fp)
    
61. )
    
62. (close fp)
    
63. (if (> (setq dcl_id (load_dialog (findfile "dq.dcl"))) 0) (progn
    
64.   (if (new_dialog "dq" dcl_id "") (progn
    
65.    (action_tile "hl" "(done_dialog 1)")
    
66.    (action_tile "hm" "(done_dialog 2)")
    
67.    (action_tile "hr" "(done_dialog 3)")
    
68.    (action_tile "vt" "(done_dialog 4)")
    
69.    (action_tile "vm" "(done_dialog 5)")
    
70.    (action_tile "vd" "(done_dialog 6)")
    
71.    (action_tile "cancel" "(done_dialog 0)")
    
72.    (setq re (start_dialog))
    
73.   )
    
74.    (princ "\n无法显示对话框！")
    
75.   )
    
76.   (unload_dialog dcl_id)
    
77. )
    
78.   (princ "\n无法加载对话框！")
    
79. )
    
80. (cond
    
81.   ((= re 1) (process "HL"))
    
82.   ((= re 2) (process "HM"))
    
83.   ((= re 3) (process "HR"))
    
84.   ((= re 4) (process "VT"))
    
85.   ((= re 5) (process "VM"))
    
86.   ((= re 6) (process "VD"))
    
87. )
    
88. (princ)
    
89. )
    

(defun process (amode / apnt apnt_x apnt_y count objname vlaxobj MinPoint MaxPoint<br />                         minext maxext ext_l ext_r ext_m ext_vt ext_vd ext_vm tpnt)<br /> (setq oldcmdecho (getvar "cmdecho"))<br /> (setvar "cmdecho" 0)<br /> (setq selobjs (ssget))<br /> (if (or (not selobjs) (= (sslength selobjs) 1))<br />   (princ "\n你必须选定两个或两个以上的对象")<br /> )<br /> (initget 1)<br /> (setq apnt (getpoint "\n选择对齐点："))<br /> (setq apnt_x (car apnt)<br />        apnt_y (cadr apnt))<br /> (vl-load-com)<br /> (setq count 0)<br /> (repeat (sslength selobjs)<br />   (setq objname (ssname selobjs count))<br />   (setq vlaxobj (vlax-ename->vla-object objname))<br />   (setq MinPoint (vlax-make-variant))<br />   (setq MaxPoint (vlax-make-variant))<br />   (vla-GetBoundingBox vlaxobj 'MinPoint 'MaxPoint)<br />   (setq minext (vlax-safearray->list MinPoint))<br />   (setq maxext (vlax-safearray->list MaxPoint))<br />   (setq ext_l (car minext))<br />   (setq ext_r (car maxext))<br />   (setq ext_m (+ (/ (abs (- ext_l ext_r)) 2) ext_l))<br />   (setq ext_vd (cadr minext))<br />   (setq ext_vt (cadr maxext))<br />   (setq ext_vm (+ (/ (abs (- ext_vt ext_vd)) 2) ext_vd))<br />   (cond<br />    ((= amode "HL") (setq tpnt (list ext_l apnt_y)))<br />    ((= amode "HM") (setq tpnt (list ext_m apnt_y)))<br />    ((= amode "HR") (setq tpnt (list ext_r apnt_y)))<br />    ((= amode "VT") (setq tpnt (list apnt_x ext_vt)))<br />    ((= amode "VM") (setq tpnt (list apnt_x ext_vm)))<br />    ((= amode "VD") (setq tpnt (list apnt_x ext_vd)))<br />   )<br />   (if tpnt (command "_move" objname "" "non" tpnt "non" apnt))<br />   (setq count (1+ count))<br /> )<br /> (setvar "cmdecho" oldcmdecho)<br /> )<br /> (defun c:dq ()<br /> (setq fp (open "dq.dcl" "w"))<br /> (foreach x<br />   '("dq:dialog{\n"<br /> " label=\"对齐物体 2013\";\n"<br /> " :row{\n"<br /> "  :button{label=\" 左对齐 \";key=\"hl\";allow_accept=true;}\n"<br /> "  :button{label=\"水平居中\";key=\"hm\";allow_accept=true;}\n"<br /> "  :button{label=\" 右对齐 \";key=\"hr\";allow_accept=true;}\n"<br /> " }\n"<br /> " :row{\n"<br /> "  :button{label=\" 上对齐 \";key=\"vt\";allow_accept=true;}\n"<br /> "  :button{label=\"垂直居中\";key=\"vm\";allow_accept=true;}\n"<br /> "  :button{label=\" 下对齐 \";key=\"vd\";allow_accept=true;}\n"<br /> " }\n"<br /> " cancel_button;\n"<br /> "}\n"<br /> )<br /> (princ x fp)<br /> )<br /> (close fp)<br /> (if (> (setq dcl_id (load_dialog (findfile "dq.dcl"))) 0) (progn<br />   (if (new_dialog "dq" dcl_id "") (progn<br />    (action_tile "hl" "(done_dialog 1)")<br />    (action_tile "hm" "(done_dialog 2)")<br />    (action_tile "hr" "(done_dialog 3)")<br />    (action_tile "vt" "(done_dialog 4)")<br />    (action_tile "vm" "(done_dialog 5)")<br />    (action_tile "vd" "(done_dialog 6)")<br />    (action_tile "cancel" "(done_dialog 0)")<br />    (setq re (start_dialog))<br />   )<br />    (princ "\n无法显示对话框！")<br />   )<br />   (unload_dialog dcl_id)<br /> )<br />   (princ "\n无法加载对话框！")<br /> )<br /> (cond<br />   ((= re 1) (process "HL"))<br />   ((= re 2) (process "HM"))<br />   ((= re 3) (process "HR"))<br />   ((= re 4) (process "VT"))<br />   ((= re 5) (process "VM"))<br />   ((= re 6) (process "VD"))<br /> )<br /> (princ)<br /> )<br />

hnlgy

感谢ZZXXQQ 版主出手，经测试可用。唯一的缺陷是正好把顶端对齐与底端对齐效果弄反了。
  ((= amode "VT") (setq tpnt (list apnt_x ext_vl)))
   ((= amode "VM") (setq tpnt (list apnt_x ext_vm)))
   ((= amode "VD") (setq tpnt (list apnt_x ext_vr)))

这三句换成下面的
  ((= amode "VD") (setq tpnt (list apnt_x ext_vl)))
   ((= amode "VM") (setq tpnt (list apnt_x ext_vm)))
   ((= amode "VT") (setq tpnt (list apnt_x ext_vr)))

就正是我所需要的效果。
  

ZZXXQQ

5楼改了，再试试。

龙城飞将36

错误: 参数类型错误: numberp: nil
((= amode "HL") (setq tpnt (list ext_l apnt_y)))  tpnt为nil

龙城飞将36

关了，重试正常了~~~~~~~~~~~~~~~~~~~~~~~~~~~~···

注册

ZZXXQQ 发表于 2013-6-11 16:44
;主函数改了下，加上了对话框。

z版粽子节快乐哈