社区 › AutoLISP/Visual LISP 编程技术 › 能不能实现图元批量对齐，请大师们指教了

sdflq 发表于 2013-8-5 13:40:09

学习了，好东西

yunfengning 发表于 2013-8-5 14:13:09

G版的....样样精华啊

陈亚娣 发表于 2013-8-5 14:32:10

顶，G版

819534890 发表于 2013-8-5 17:49:16

又是回复看看，多看多学

oldenn 发表于 2013-8-5 18:55:35

学习学习。谢谢分享

crazylsp 发表于 2013-9-21 17:22:05

我又修改了一下程序 ，看看能不能


;;修改的程序


;;对齐

(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)      

      )


      (initget "H S")

      (setq key (getkword "[横向对齐(H)/竖向对齐(S)]:" ) )

   (cond

    (

    (= key "H")


      ;_ 按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) )


         (setqTMP s2s2 s1s1 TMP    )


         

      )

      (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))   

       )   

    )



   


      (

      (= key "S")

          ;_ 按X从大到小排序

          (setq s1 (mapcar '(lambda (x) (list x (GXL-GETBOXCENTER x))) s1))

          (setq s1 (vl-sort s1 '(lambda (a b) (> (car(cadr a)) (car(cadr b)) ) ) ))


          (setq s2 (mapcar '(lambda (x) (list x (GXL-GETBOXCENTER x))) s2))

          (setq s2 (vl-sort s2 '(lambda (a b) (> (car(cadr a)) (car(cadr b)) ) ) ))

               ;_ 表长比较

          (if(> (length s1) (length s2) )


             (setqTMP s2s2 s1s1 TMP    )


          )





          (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 p1) (cadr p2)(caddr p2))) ;;得到对齐点      

                (command "move" e2 "" p2 p3)      

            ) )   

             (setq n (1+ n))   

          )   

      )

    )


      (setvar 'osmode osmode)   

      (setvar 'cmdecho cmdecho)

      (princ)

)

sixth 发表于 2013-9-23 10:06:13

顶G版，强，太牛

spp_wall 发表于 2013-9-23 11:37:44

厉害！！！！！！！！！！！！！

zzmm 发表于 2013-9-24 15:10:57

学习一下 看看思路

my_mjtd 发表于 2013-9-25 16:14:35

回帖只为看帖。
感谢gu版主。

查看完整版本: 能不能实现图元批量对齐，请大师们指教了