能不能实现图元批量对齐，请大师们指教了

fanqinwei

已经用上了，好顺手呀，谢G版了。

crazylsp

;; 对齐
;; 兴趣来了，GX基础上改了下，未测试，不行再改。


(defun c:pldq ()

;;子程序  
;;选择集转表  
  (defun gxl-Sel-SS->List (ss / i s )  
    (if ss  
      (repeat  (setq i (sslength ss))  
         (setq s (cons (ssname ss (setq i (1- i))) s))    )    ))

           ;;计算物体中心点  
            (defun gxl-getboxCenter (e1 / obj minpoint maxpoint)  

              (if (= 'ENAME (type e1))  

                  (setq obj (vlax-ename->vla-object e1))

                  ;转换图元名   
                  (setq obj e1)   
              )  

          (vla-GetBoundingBox obj 'minpoint 'maxpoint)
          ;取得包容图元的最大点和最小点  
          (setq minpoint (vlax-safearray->list minpoint))
          ;把变体数据转化为表  
          (setq maxpoint (vlax-safearray->list maxpoint))
          ;把变体数据转化为表  
          (setq p (mapcar '+ minpoint maxpoint))   
          (mapcar '(lambda (x) (* 0.5 x)) p))  


;;主程序  
      (setq cmdecho (getvar 'cmdecho))  
      (setq osmode (getvar 'osmode))  
      (setvar 'osmode 0)  
      (setvar 'cmdecho 0)  
      (princ "\n选择基准物体:")  
      (setq s1 (ssget))  
      (princ "\n选择要对齐物体:")  
      (setq s2 (ssget))  
      (setq s1 (GXL-SEL-SS->LIST s1)        
            s2 (GXL-SEL-SS->LIST s2)        
      )  
      ;_ 按Y从大到小排序
      (setq s1 (mapcar '(lambda (x) (list x (GXL-GETBOXCENTER x))) s1))  
      (setq s1 (vl-sort s1 '(lambda (a b) (> (cadadr a) (cadadr b))) ))

        
      (setq s2 (mapcar '(lambda (x) (list x (GXL-GETBOXCENTER x))) s2))  
      (setq s2 (vl-sort s2 '(lambda (a b) (> (cadadr a) (cadadr b))) ))

      ;_ 表长比较
      (if  (> (length s1) (length s2) )

         (setq    TMP s2    s2 s1   s1 TMP   )

         
      )



      
      (initget "H S")
      (setq key (getkword "[横向对齐(H)/竖向对齐(S)]:  " ) )
      (cond
        (
          (= key "H")  (hen)
        )
        (
          (= key "S")  (shu)
        )
      )



     (defun hen()
  
      (setq n 0)  
      (repeat (length s1)   
         (setq e1 (car (nth n s1))         
               p1 (cadr (nth n s1))         
         )   
         (if (setq e2 (car (nth n s2)))      
         (progn        
           (setq p2 (cadr (nth n s2)))        
           (setq p3 (list (car p2) (cadr p1) (caddr p2)))        
           (command "move" e2 "" p2 p3)        
         ) )   
         (setq n (1+ n))   
      )   

     )

     (defun shu()
  
      (setq n 0)  
      (repeat (length s1)   
         (setq e1 (car (nth n s1))         
               p1 (cadr (nth n s1))         
         )   
         (if (setq e2 (car (nth n s2)))      
         (progn        
           (setq p2 (cadr (nth n s2)))        
           (setq p3 (list (cadr p2) (car p1) (caddr p2)))        
           (command "move" e2 "" p2 p3)        
         ) )   
         (setq n (1+ n))   
      )   

     )



      (setvar 'osmode osmode)   
      (setvar 'cmdecho cmdecho)
      (princ)  
)

lidaxiu

恩不错，可是没运行成功呢，提示  no function definition: HEN

lz123456

crazylsp
运行你修改的那后，无反应。那对齐没效果。cad2010 64

soly2006

看看情况，拿分走人

dwg001

学习G版的招数

梁智泓

G版太强大了

ledisonsen

看起来这个程序非常不错

yiming61

批量对齐不错不错

ptime

谢谢分享程序。