求这功能的一个小程序，类似于自动对齐

k1nger

vitalgg 发表于 2021-3-13 08:40
他这个对动态块支持不太好，动态块得到的长宽都一样。
你需要读取每个可见性对应的匿名块，取这个匿名块 ...

是的，我这个需要读取相应的可见性里的数集，所以不好弄啊

k1nger

问题已解决，明币还在，你说气人不，谢谢院长的技术支持

xj6019

那就送给我吧

k1nger

xj6019 发表于 2021-3-13 19:43
那就送给我吧

你的比我的还我多，你咋好意思说来！

xj6019

那就给你+1个

k1nger

xj6019 发表于 2021-3-15 14:58
那就给你+1个

努力学习，争取自己当大神

k1nger

还是这一个程序，下面做一个小总结，这个程序的功能就是图块之间的零间距排版的一个，基点对齐，求大神完善一下程序！下面的程序供大家参考！
1、下面的这个程序是院长给写的一个，缺点，自定义函数太多，需要用院长的自定义函数才能用，
(defun c:tt4 () ;tt(动态块排版)
  (xyp-Start)
  (defun abc (s1 / ob dp a)
    (setq ob (vlax-ename->vla-object s1)
          dp (vla-getdynamicblockproperties ob)
          a  (car (vlax-safearray->list (vlax-variant-value dp)))
          a  (distof (vlax-get a 'Value))
    )
  )
  (if (setq ss (ssget '((0 . "insert"))))
    (progn
      (setq lst        (vl-sort (xyp-Ss2List ss)
                         '(lambda (x y) (< (car (ss9pt x 1)) (car (ss9pt y 1))))
                )
            p0        (xyp-DXF 10 (car lst))
      )
      (foreach s1 lst
        (xyp-move s1 (xyp-DXF 10 s1) p0)
        (setq p0 (xyp-Pt2X p0 (abc s1)))
      )
    )
  )
  (xyp-End)
)

2、下面这个是论坛里找到一个，也是不能用，大神们参考一下

;;单体对齐、等距排列插件。
;;双向对齐不做排列，水平：以左下角x值由左到右排列，垂直：以左下角y值由下到上排列。
;;编码思路：1，利用院长外包围9点函数找到合适移动基点。2，根据对齐形式计算移动终点。3，移动命令完成最后步骤。
(defun c:tt5 () (c:ent_DQPL));;方便自己调试设的快捷键
;==========================================================================对话框程式代码（不熟不多说）
(defun c:ent_DQPL (/ DCL dd)
  (setq DCL (load_dialog (make-dcl)))
  (new_dialog "rect01" DCL)
        ;;水平
  (action_tile "dtpl1" "(S_RECT) (done_dialog 1)")
        (action_tile "dtpl2" "(S_RECT) (done_dialog 2)")
        (action_tile "dtpl3" "(S_RECT) (done_dialog 3)")
        ;;垂直
        (action_tile "dtpl4" "(S_RECT) (done_dialog 4)")
        (action_tile "dtpl5" "(S_RECT) (done_dialog 5)")
        (action_tile "dtpl6" "(S_RECT) (done_dialog 6)")
        ;;双向
        (action_tile "dtpl7" "(done_dialog 7)")
        (action_tile "dtpl8" "(done_dialog 8)")
        (action_tile "dtpl9" "(done_dialog 9)")
        (action_tile "dtpl10" "(done_dialog 10)")
        (action_tile "dtpl11" "(done_dialog 11)")
        (action_tile "dtpl12" "(done_dialog 12)")
  (action_tile "dtpl13" "(done_dialog 13)")
        (action_tile "dtpl14" "(done_dialog 14)")
        (action_tile "dtpl15" "(done_dialog 15)")
        ;;重排
        (set_tile "cp_d" "100")
        (action_tile "dxjj" "(done_dialog 16)")
        (setq dd (start_dialog ))
        (if cp_dx1 (setq cp_xx 1))
        (cond ((= dd 1) (if (= cp_xx 1) (S_PLcx 0 7 9 0) (S_DQcx 0 9)))
                ((= dd 2) (if (= cp_xx 1) (S_PLcx 0 4 6 0) (S_DQcx 0 5)))
                ((= dd 3) (if (= cp_xx 1) (S_PLcx 0 1 3 0) (S_DQcx 0 1)))
                ((= dd 4) (if (= cp_xx 1) (S_PLcx 1 1 7 (* 0.5 pi)) (S_DQcx 1 1)))
                ((= dd 5) (if (= cp_xx 1) (S_PLcx 1 2 8 (* 0.5 pi)) (S_DQcx 1 5)))
                ((= dd 6) (if (= cp_xx 1) (S_PLcx 1 3 9 (* 0.5 pi)) (S_DQcx 1 9)))
                ((= dd 7) (S_DQcx 2 7))
                ((= dd 8) (S_DQcx 2 4))
                ((= dd 9) (S_DQcx 2 1))
                ((= dd 10) (S_DQcx 2 8))
                ((= dd 11) (S_DQcx 2 5))
                ((= dd 12) (S_DQcx 2 2))
                ((= dd 13) (S_DQcx 2 9))
                ((= dd 14) (S_DQcx 2 6))
                ((= dd 15) (S_DQcx 2 3))
                ((= dd 16) (S_RECT2))
        )
  (princ)
)
;==========================================================================辅助函数
;;提取勾选键、排距数值
(DEFUN S_RECT()
        (SETQ cp_dx (ABS (ATOF (GET_TILE "cp_d"))) ;间距值
                cp_xx (atoi (GET_TILE "cp_x"))) ;切换钮的状态
)
(defun S_RECT2 (/ pdx1);;选点定距函数
        (setq cp_dx1 (distance (setq pdx1(getpoint)) (getpoint pdx1)))
        (c:ent_DQPL)
)
;; 院长函数 / 外包盒9点坐标；在此程序中发挥关键作用
(defun ss9pt (entname n / ss i s1 ll rr box ptn a p1 p2 p3 p4 p5 p6 p7 p8 p9)
        (if (setq ss (ssadd) ss (ssadd entname ss))
    (progn
      (setq i -1)
      (repeat (sslength ss)
                                (setq s1 (ssname ss (setq i (1+ i))))
                                (vla-GetBoundingBox (vlax-ename->vla-object s1) 'll 'rr)
                                (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr))
                                        ptn (append box ptn)
                                )
      )
      (setq a  (mapcar '(lambda (x) (apply 'mapcar (cons x ptn))) (list 'min 'max))
                                p1 (car a)
                                p9 (cadr a)
                                p5 (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p9)
                                p2 (list (car p5) (cadr p1))
                                p3 (list (car p9) (cadr p1))
                                p4 (list (car p1) (cadr p5))
                                p6 (list (car p9) (cadr p5))
                                p7 (list (car p1) (cadr p9))
                                p8 (list (car p5) (cadr p9))
      )
      (nth (- n 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))
    )
  )
)
;;选择集=>>名表
(defun SStoLST (ss / i entname lst)
        (setq i -1)
        (if ss
                (while (setq entname (ssname ss(setq i(1+ i))))
                        (setq lst (cons entname lst))))
        (reverse lst)
)
;==========================================================================主处理函数1
;;对齐主程序,/ H-S=0：水平 / H-S=1：垂直 / H-S=2:双向 / 9NB:移动基点 /
(defun S_DQcx (H-S 9NB / ang entname i nb nb0 p0 p1 p1a p2 ss sslst sslst_px)
        (command "undo" "be");撤销开始点，对于批量操作做好撤销设置，不然一步步后退很麻烦。
        (prompt "\n选择对象:"); ssget 后面不能带操作说明，在其前可以用 prompt 先行提示。
  (setq ss (ssget))
  (setq p0 (getpoint "\n选择对齐基点<退出>: "));getpoint 等很多函数后面可以接说明，\n 换行号，命令行会换一行再提示。
  (setq i -1);为了配合下面 ssname 函数设的变量，第一个对象编号为 0，所以设为 -1。
        (while (setq entname (ssname ss (setq i (1+ i))));while 对选集全部对象做循环处理，也可以用 repeat 函数来做。
                (setq  p1 (ss9pt entname 9NB));9NB是此函数参数之一，就是对象的9点之一（移动基点p1），根据对齐形式选取。
                (cond ((= H-S 0) (setq p2 (list (car p1) (cadr p0))));H-S也是参数之一，根据他来计算移动的目标点 p2
                        ((= H-S 1) (setq p2 (list (car p0) (cadr p1))))
                        ((= H-S 2) (setq p2 p0));双向对齐时，选的点p0就是目标点p2
                )
                (command "MOVE" entname "" "non" p1 "non" p2);移动命令完成
        );while
        (command "undo" "e");撤销结束点，与开始点之间的操作一步撤销完成
        (princ);这个是标配吧
);结束
;==========================================================================主处理函数2
;;排列主程序,/ H-S=0：水平 / H-S=1：垂直 / ang:水平0，垂直90° / NB:对象移动基点 / NB0: 移动目标点(选取合适的9点之一来计算)
(defun S_PLcx (H-S NB NB0 ang / entname i p0 p1a ss sslst sslst_px)
  (command "undo" "be");同上
  (setq ss (ssget))
        (setq p0 (getpoint "\n选择对齐基点<退出>: "));排列的起点
        (setq sslst (SStoLST ss));;选集转成表以便下面进行排序
        ;等距排列其实跟上面对齐操作原理一样，但是要对选集对象排序一下，不然会乱，因为这里的移动终点是根据前对象计算的，而对齐只要根据自己点位计算就行。
        (cond ((= H-S 0) (setq sslst_px (vl-sort sslst '(lambda (a b) (< (car (ss9pt a 1)) (car (ss9pt b 1)))))));;横排时按对象1点的x值小到大排序，得到新表
                ((= H-S 1) (setq sslst_px (vl-sort sslst '(lambda (a b) (< (cadr (ss9pt a 1)) (cadr (ss9pt b 1)))))));;竖排时按对象1点的y值小到大排序，得到新表
        );cond
        (setq i 0);这里循环设的i是0，和上面-1是一样效果，都是从编号0开始
        (repeat (length sslst_px);这里用了repeat函数，注意这里对象是表，对比一下上面 while 的对象是选集，会发现原理一样，但用到的函数不一样
                (setq entname (nth i sslst_px)
                        p1a (ss9pt entname NB);移动基点
                )
                (command "MOVE" entname "" "non" p1a "non" p0);移动命令
                (if (not cp_dx1) (setq cp_dx1 cp_dx));这是对话框的一些代码
                (setq p0 (polar (ss9pt entname NB0) ang cp_dx1) i (1+ i))        ;这里是计算下一个对象的移动终点(p0重新赋值，循环使用)
        );repeat
        (command "undo" "e");同上
        (setq cp_dx1 nil);这是对话框的
        (princ)
)
;==========================================================================对话框定义代码(插件生成)
;;;=================================================================*
;;;生成日期：20200302.000904
;;;本文件由程序自动生成。                                           *
;;;程序生成完成后需将主代码“*.lsp”文件中的语句中的     *
;;; (load_dialog 双引号*.Dcl双引号)改为(load_dialog (make-dcl)) 方可用            *
;;;修改后的代码可编辑到主LISP程序后方运行                                                                 *
;;;=================================================================*
;;;为能让多个有本程序生成的DCL.lsp可以同时使用，生成程序后应将对话框名 (make-dcl)改名   *
;;;供需修改两处地方，一处为加载的地方(load_dialog (？？？-make-dcl)) ，另一处为       *
;;;对话框主程序名(defun ？？？-make-dcl    ，一定要一致                      *
;;;示例：(make-dcl)                                                 *
(defun make-dcl  (/ lst_str str file f)
                (setq lst_str '(
"rect01:dialog {"
"    label = \"对齐/排列\" ;"
"    :spacer {}"
"    :row {"
"        :column {"
"            label = \"水平对齐\" ;"
"            :button {"
"                key = \"dtpl1\" ;"
"                label = \"┳\" ;"
"            }"
"            :button {"
"                key = \"dtpl2\" ;"
"                label = \"━\" ;"
"            }"
"            :button {"
"                key = \"dtpl3\" ;"
"                label = \"┻\" ;"
"            }"
"        }"
"        :column {"
"            label = \"垂直对齐\" ;"
"            :button {"
"                key = \"dtpl4\" ;"
"                label = \"┣\" ;"
"            }"
"            :button {"
"                key = \"dtpl5\" ;"
"                label = \"┃\" ;"
"            }"
"            :button {"
"                key = \"dtpl6\" ;"
"                label = \"┫\" ;"
"            }"
"        }"
"        :row {"
"            label = \"双向对齐\" ;"
"            :column {"
"                :button {"
"                    key = \"dtpl7\" ;"
"                    label = \"╔\" ;"
"                }"
"                :button {"
"                    key = \"dtpl8\" ;"
"                    label = \"╠\" ;"
"                }"
"                :button {"
"                    key = \"dtpl9\" ;"
"                    label = \"╚\" ;"
"                }"
"            }"
"            :column {"
"                :button {"
"                    key = \"dtpl10\" ;"
"                    label = \"╦\" ;"
"                }"
"                :button {"
"                    key = \"dtpl11\" ;"
"                    label = \"╬\" ;"
"                }"
"                :button {"
"                    key = \"dtpl12\" ;"
"                    label = \"╩\" ;"
"                }"
"            }"
"            :column {"
"                :button {"
"                    key = \"dtpl13\" ;"
"                    label = \"╗\" ;"
"                }"
"                :button {"
"                    key = \"dtpl14\" ;"
"                    label = \"╣\" ;"
"                }"
"                :button {"
"                    key = \"dtpl15\" ;"
"                    label = \"╝\" ;"
"                }"
"            }"
"        }"
"    }"
"    :boxed_row {"
"        height = 1 ;"
"        :toggle {"
"            alignment = centered ;"
"            key = \"cp_x\" ;"
"            label = \"等距重排>>>\" ;"
"        }"
"        :edit_box {"
"            alignment = top ;"
"            key = \"cp_d\" ;"
"            label = \"间距mm:\" ;"
"            value = \"100\" ;"
"        }"
"        :button {"
"            key = \"dxjj\" ;"
"            label = \"点选定距\" ;"
"        }"
"    }"
"    :spacer {}"
"    cancel_button;"
"}"
                    )
    )
    (setq file (vl-filename-mktemp "DclTemp.dcl"))
    (setq f (open file "w"))
    (foreach str lst_str
        (princ "\n" f)
        (princ str f)
    )
    (close f)
    ;;返回
    file
)
;;;=================================================================*
(princ)

k1nger

挖坟
！！！！上个效果

xj6019

恭喜大功告成呀！！可喜可贺！！

babylon1386

收藏了  有空研究