[求助]程序完善

xyz2009xyz

本程序为对象垂直对齐程序，不知道哪位大虾能完善一下增加一个对象水平对齐功能；
本程序来自网络，感谢原作者！

3. ;;程序名称：对象水平垂直程序
4. ;;执行命令：ahobj
5. ;;程序功能：将选定的对象左对齐、右对齐或对中。
6. ;;
7. ;;
8. (defun c:QD (/ selobjs oldcmdecho)
9.   (setq oldcmdecho (getvar "cmdecho"))
10.   (setvar "cmdecho" 0)
11.   (setq selobjs (ssget))
12.   (if (or (not selobjs) (= (sslength selobjs) 1))
13.     (princ "\n你必须选定两个或两个以上的对象")
14.     (process selobjs)
15.   )
16.   (setvar "cmdecho" oldcmdecho)
17.   (princ)
18. )
19. (defun process (selobjs   /     amode     apnt apnt_x
20.   apnt_y   count     objname   vlaxobj MinPoint
21.   MaxPoint  minext   maxext   ext_l ext_r
22.   ext_m   tpnt
23.         )
24.   (initget "L M R")
25.   (setq amode (getkword
26.   "\n选择对齐方式[左对齐(L)/对中(M)/右对齐(R)]<左对齐>:"
27.        )
28.   )
29.   (if (not amode)
30.     (setq amode "L")
31.   )
32.   (initget 1)
33.   (setq apnt (getpoint "\n选择水平对齐方向的对齐点："))
34.   (setq apnt_x (car apnt)
35. apnt_y (cadr apnt)
36.   )
37.   (vl-load-com)
38.   (setq count 0)
39.   (repeat (sslength selobjs)
40.     (setq objname (ssname selobjs count))
41.     (setq vlaxobj (vlax-ename->vla-object objname))
42.     (setq MinPoint (vlax-make-variant))
43.     (setq MaxPoint (vlax-make-variant))
44.     (vla-GetBoundingBox vlaxobj 'MinPoint 'MaxPoint)
45.     (setq minext (vlax-safearray->list MinPoint))
46.     (setq maxext (vlax-safearray->list MaxPoint))
47.     (setq ext_l (car minext))
48.     (setq ext_r (car maxext))
49.     (setq ext_m (+ (/ (abs (- ext_l ext_r)) 2) ext_l))
50.     (cond
51.       ((= amode "L")
52.        (setq tpnt (list ext_l apnt_y))
53.       )
54.       ((= amode "M")
55.        (setq tpnt (list ext_m apnt_y))
56.       )
57.       ((= amode "R")
58.        (setq tpnt (list ext_r apnt_y))
59.       )
60.     )
61.     (if tpnt
62.       (command "_move" objname "" "non" tpnt "non" apnt)
63.     )
64.     (setq count (1+ count))
65.   )
66. )
69. (defun c:XDTB_EntAlign (/ tf mat mats e box p lef rig cen mid ss v)
70.   (if (setq p (getpoint "\n对齐点: "))
71.     (progn
72.       (initget "0 1 2 3 4")
73.       (if (not (setq tf
74.         (getkword
75.    "\n请选择基点类型[0-左对齐 / 1-底对齐 / 2-右对齐 / 3-垂直居中 / 4-水平居中]<0>:"
76.         )
77.         )
78.    )
79. (setq tf "0")
80.       )
81.       (initget 6)
82.       (setq mat (xdrx_matrix_identity 3))
83.       (while (and
84.         (progn
85.    (prompt "\r请选取要对齐的实体<结束>:")
86.    t
87.         )
88.         (setq ss (ssget))
89.       )
90. (xdrx_begin)
91. (xdrx_ucson)
92. (xdrx_setsstodb ss 0)
93. (while (setq e (xdrx_getentdata 0))
94.    (setq box  (xdrx_entity_box e)
95.   lef  (car box)
96.   mid  (xdrx_midp (car box) (cadr box))
97.   rig  (cadr box)
98.   cen  (xdrx_midp (car box) (caddr box))
99.   v    (cond
100.          ((= tf "0")
101.    (list (- (car p) (car lef)) 0. 0.)
102.          )
103.          ((= tf "1")
104.    (list 0. (- (cadr p) (cadr lef)) 0.)
105.          )
106.          ((= tf "2")
107.    (list (- (car p) (car rig)) 0. 0.)
108.          )
109.          ((= tf "3")
110.    (list (- (car p) (car mid)) 0. 0.)
111.          )
112.          (t
113.    (list 0. (- (cadr p) (cadr cen)) 0.)
114.          )
115.        )
116.   mats (xdrx_matrix_SetTranslation mat v)
117.    )
118.    (xdrx_entity_transform e mats)
119. )
120. (xdrx_ucsoff)
121. (xdrx_end)
122.       )
123.     )
124.   )
125.   (princ)
126. )

;;程序名称：对象水平垂直程序 ;;执行命令：ahobj ;;程序功能：将选定的对象左对齐、右对齐或对中。 ;; ;; (defun c:QD (/ selobjs oldcmdecho)   (setq oldcmdecho (getvar "cmdecho"))   (setvar "cmdecho" 0)   (setq selobjs (ssget))   (if (or (not selobjs) (= (sslength selobjs) 1))     (princ "\n你必须选定两个或两个以上的对象")     (process selobjs)   )   (setvar "cmdecho" oldcmdecho)   (princ) ) (defun process (selobjs   /     amode     apnt apnt_x   apnt_y   count     objname   vlaxobj MinPoint   MaxPoint  minext   maxext   ext_l ext_r   ext_m   tpnt         )   (initget "L M R")   (setq amode (getkword   "\n选择对齐方式[左对齐(L)/对中(M)/右对齐(R)]<左对齐>:"        )   )   (if (not amode)     (setq amode "L")   )   (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 "L")        (setq tpnt (list ext_l apnt_y))       )       ((= amode "M")        (setq tpnt (list ext_m apnt_y))       )       ((= amode "R")        (setq tpnt (list ext_r apnt_y))       )     )     (if tpnt       (command "_move" objname "" "non" tpnt "non" apnt)     )     (setq count (1+ count))   ) ) (defun c:XDTB_EntAlign (/ tf mat mats e box p lef rig cen mid ss v)   (if (setq p (getpoint "\n对齐点: "))     (progn       (initget "0 1 2 3 4")       (if (not (setq tf         (getkword    "\n请选择基点类型[0-左对齐 / 1-底对齐 / 2-右对齐 / 3-垂直居中 / 4-水平居中]<0>:"         )         )    ) (setq tf "0")       )       (initget 6)       (setq mat (xdrx_matrix_identity 3))       (while (and         (progn    (prompt "\r请选取要对齐的实体<结束>:")    t         )         (setq ss (ssget))       ) (xdrx_begin) (xdrx_ucson) (xdrx_setsstodb ss 0) (while (setq e (xdrx_getentdata 0))    (setq box  (xdrx_entity_box e)   lef  (car box)   mid  (xdrx_midp (car box) (cadr box))   rig  (cadr box)   cen  (xdrx_midp (car box) (caddr box))   v    (cond          ((= tf "0")    (list (- (car p) (car lef)) 0. 0.)          )          ((= tf "1")    (list 0. (- (cadr p) (cadr lef)) 0.)          )          ((= tf "2")    (list (- (car p) (car rig)) 0. 0.)          )          ((= tf "3")    (list (- (car p) (car mid)) 0. 0.)          )          (t    (list 0. (- (cadr p) (cadr cen)) 0.)          )        )   mats (xdrx_matrix_SetTranslation mat v)    )    (xdrx_entity_transform e mats) ) (xdrx_ucsoff) (xdrx_end)       )     )   )   (princ) )

xyz2009xyz

把源程序附件传上来，希望有大虾和版主多多帮助！感谢！

xyz2009xyz

希望有大虾和版主多多帮助啊！

piao1887

2. (defun c:QD (/ selobjs oldcmdecho)
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. (process selobjs)
9. )
10. (setvar "cmdecho" oldcmdecho)
11. (princ)
12. )
13. (defun process (selobjs     /     amode apnt    apnt_x
14.         apnt_y     count     objname vlaxobj    MinPoint
15.         MaxPoint minext maxext ext_l    ext_r
16.         ext_m     tpnt
17.      )
18. (initget "L M R T MT B")
19. (setq    amode
20.      (getkword
21.      "\n选择对齐方式[左对齐(L)/对中(M)/右对齐(R)/上对齐(T)/中间(MT)/下对齐(B)]<左对齐>:"
22.      )
23. )
24. (if (not amode)
25. (setq amode "L")
26. )
27. (initget 1)
28. (setq apnt (getpoint "\n选择对齐方向的对齐点："))
29. (setq    apnt_x (car apnt)
30.     apnt_y (cadr apnt)
31. )
32. (vl-load-com)
33. (setq count 0)
34. (repeat (sslength selobjs)
35. (setq objname (ssname selobjs count))
36. (setq vlaxobj (vlax-ename->vla-object objname))
37. (setq MinPoint (vlax-make-variant))
38. (setq MaxPoint (vlax-make-variant))
39. (vla-GetBoundingBox vlaxobj 'MinPoint 'MaxPoint)
40. (setq minext (vlax-safearray->list MinPoint))
41. (setq maxext (vlax-safearray->list MaxPoint))
42. (setq ext_l (car minext))
43. (setq ext_r (car maxext))
44. (setq ext_m (+ (/ (abs (- ext_l ext_r)) 2) ext_l))
45. (setq ext_t (cadr maxext))
46. (setq ext_b (cadr minext))
47. (setq ext_mt (+ (/ (abs (- ext_t ext_b)) 2) ext_b))
48. (cond
49. ((= amode "L")
50. (setq tpnt (list ext_l apnt_y))
51. )
52. ((= amode "M")
53. (setq tpnt (list ext_m apnt_y))
54. )
55. ((= amode "R")
56. (setq tpnt (list ext_r apnt_y))
57. )
58. ((= amode "T")
59. (SETQ tpnt (list apntx ext_t))
60. )
61. ((= amode "MT")
62. (setq tpnt (list apnt_x ext_mt))
63. )
64. ((= amode "B")
65. (setq tpnt (list apnt_x ext_b))
66. )
67. )
68. (if    tpnt
69. (command "_move" objname "" tpnt apnt)
70. )
71. (setq count (1+ count))
72. )
73. )

(defun c:QD (/ selobjs oldcmdecho) (setq oldcmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (setq selobjs (ssget)) (if (or (not selobjs) (= (sslength selobjs) 1)) (princ "\n你必须选定两个或两个以上的对象") (process selobjs) ) (setvar "cmdecho" oldcmdecho) (princ) ) (defun process (selobjs     /     amode apnt    apnt_x         apnt_y     count     objname vlaxobj    MinPoint         MaxPoint minext maxext ext_l    ext_r         ext_m     tpnt      ) (initget "L M R T MT B") (setq    amode      (getkword      "\n选择对齐方式[左对齐(L)/对中(M)/右对齐(R)/上对齐(T)/中间(MT)/下对齐(B)]<左对齐>:"      ) ) (if (not amode) (setq amode "L") ) (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)) (setq ext_t (cadr maxext)) (setq ext_b (cadr minext)) (setq ext_mt (+ (/ (abs (- ext_t ext_b)) 2) ext_b)) (cond ((= amode "L") (setq tpnt (list ext_l apnt_y)) ) ((= amode "M") (setq tpnt (list ext_m apnt_y)) ) ((= amode "R") (setq tpnt (list ext_r apnt_y)) ) ((= amode "T") (SETQ tpnt (list apntx ext_t)) ) ((= amode "MT") (setq tpnt (list apnt_x ext_mt)) ) ((= amode "B") (setq tpnt (list apnt_x ext_b)) ) ) (if    tpnt (command "_move" objname "" tpnt apnt) ) (setq count (1+ count)) ) )

mmh1

(defun c:zd1()
 (setvar "CMDECHO" 0)
(setq sel1 (ssget))
(setq l1 (entsel "\n 选择直线:"))
(setq d (entget (car l1)))
(setq P1 (cdr (assoc 10 d)))
(setq P2 (cdr (assoc 11 d)))
(setq d1 (car p1))
(setq d2 (cadr p1))
(setq d3 (car p2))
(setq d4 (cadr p2))
(setq pt (cadr l1))
(setq mm (osnap pt "mid"))
(if(> d2 d4)
(command "rotate" sel1 "" mm "r" p2 p1 90 "")
(command "rotate" sel1 "" mm "r" p1 p2 90 "")
)
(princ)
)

 

 

有点简陋！只有左边摆正，选线就可以了

xyz2009xyz

4楼这个程序好像上对齐不好用会出现如下（操作对象单行文本或者多行文本）：

   选择对齐方式[左对齐(L)/对中(M)/右对齐(R)/上对齐(T)/中间(MT)/下对齐(B)]<左对齐>:T
   选择对齐方向的对齐点：
   窗口说明无效。
   ; 错误: 函数被取消
   命令: 指定对角点:

 

 

不过还是感谢

piao1887

2. ;;程序名称：对象水平垂直程序
3. ;;执行命令：ahobj
4. ;;程序功能：将选定的对象左对齐、右对齐或对中。
5. ;;
6. ;;
7. (defun c:QD (/ selobjs oldcmdecho)
8. (setq oldcmdecho (getvar "cmdecho"))
9. (setvar "cmdecho" 0)
10. (setq selobjs (ssget))
11. (if (or (not selobjs) (= (sslength selobjs) 1))
12. (princ "\n你必须选定两个或两个以上的对象")
13. (process selobjs)
14. )
15. (setvar "cmdecho" oldcmdecho)
16. (princ)
17. )
18. (defun process (selobjs     /     amode apnt    apnt_x
19.         apnt_y     count     objname vlaxobj    MinPoint
20.         MaxPoint minext maxext ext_l    ext_r
21.         ext_m     tpnt
22.      )
23. (initget "L M R T MT B")
24. (setq    amode
25.      (getkword
26.      "\n选择对齐方式[左对齐(L)/对中(M)/右对齐(R)/上对齐(T)/中间(MT)/下对齐(B)]<左对齐>:"
27.      )
28. )
29. (if (not amode)
30. (setq amode "L")
31. )
32. (initget 1)
33. (setq apnt (getpoint "\n选择对齐方向的对齐点："))
34. (setq    apnt_x (car apnt)
35.     apnt_y (cadr apnt)
36. )
37. (vl-load-com)
38. (setq count 0)
39. (repeat (sslength selobjs)
40. (setq objname (ssname selobjs count))
41. (setq vlaxobj (vlax-ename->vla-object objname))
42. (setq MinPoint (vlax-make-variant))
43. (setq MaxPoint (vlax-make-variant))
44. (vla-GetBoundingBox vlaxobj 'MinPoint 'MaxPoint)
45. (setq minext (vlax-safearray->list MinPoint))
46. (setq maxext (vlax-safearray->list MaxPoint))
47. (setq ext_l (car minext))
48. (setq ext_r (car maxext))
49. (setq ext_m (+ (/ (abs (- ext_l ext_r)) 2) ext_l))
50. (setq ext_t (cadr maxext))
51. (setq ext_b (cadr minext))
52. (setq ext_mt (+ (/ (abs (- ext_t ext_b)) 2) ext_b))
53. (cond
54. ((= amode "L")
55. (setq tpnt (list ext_l apnt_y))
56. )
57. ((= amode "M")
58. (setq tpnt (list ext_m apnt_y))
59. )
60. ((= amode "R")
61. (setq tpnt (list ext_r apnt_y))
62. )
63. ((= amode "T")
64. (SETQ tpnt (list apnt_x ext_t))
65. )
66. ((= amode "MT")
67. (setq tpnt (list apnt_x ext_mt))
68. )
69. ((= amode "B")
70. (setq tpnt (list apnt_x ext_b))
71. )
72. )
73. (print tpnt)
74. (if    tpnt
75. (command "_move" objname "" tpnt apnt)
76. )
77. (setq count (1+ count))
78. )
79. )

;;程序名称：对象水平垂直程序 ;;执行命令：ahobj ;;程序功能：将选定的对象左对齐、右对齐或对中。 ;; ;; (defun c:QD (/ selobjs oldcmdecho) (setq oldcmdecho (getvar "cmdecho")) (setvar "cmdecho" 0) (setq selobjs (ssget)) (if (or (not selobjs) (= (sslength selobjs) 1)) (princ "\n你必须选定两个或两个以上的对象") (process selobjs) ) (setvar "cmdecho" oldcmdecho) (princ) ) (defun process (selobjs     /     amode apnt    apnt_x         apnt_y     count     objname vlaxobj    MinPoint         MaxPoint minext maxext ext_l    ext_r         ext_m     tpnt      ) (initget "L M R T MT B") (setq    amode      (getkword      "\n选择对齐方式[左对齐(L)/对中(M)/右对齐(R)/上对齐(T)/中间(MT)/下对齐(B)]<左对齐>:"      ) ) (if (not amode) (setq amode "L") ) (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)) (setq ext_t (cadr maxext)) (setq ext_b (cadr minext)) (setq ext_mt (+ (/ (abs (- ext_t ext_b)) 2) ext_b)) (cond ((= amode "L") (setq tpnt (list ext_l apnt_y)) ) ((= amode "M") (setq tpnt (list ext_m apnt_y)) ) ((= amode "R") (setq tpnt (list ext_r apnt_y)) ) ((= amode "T") (SETQ tpnt (list apnt_x ext_t)) ) ((= amode "MT") (setq tpnt (list apnt_x ext_mt)) ) ((= amode "B") (setq tpnt (list apnt_x ext_b)) ) ) (print tpnt) (if    tpnt (command "_move" objname "" tpnt apnt) ) (setq count (1+ count)) ) )

有一个变量写错了 已改正

xyz2009xyz

试验过了可以用了，不过还有一个小小问题，就是在对块上对齐的时候，会对不齐，见图：

piao1887

我测试过 可以对齐的 应该是你捕捉没关

在程序里加两句把捕捉关掉你试试

在程序最前边加

(setq os (getvar "osmode"))

(setvar "osmode" 0)

 

在程序结尾的地方加上

(setvar "osmode" os)

xyz2009xyz

捕捉关了，可以对齐了，但是有时候需要捕捉对齐点，或者文本时以第一个文本插入点作为参照就有点，

就有点不是特别好了，不过还是感谢！