1. ;==========================================================================代码说明
    2. ;;单体对齐、等距排列插件/补充图框类别选择/ST-2020.03。
    3. ;;双向对齐不做排列，水平：以左下角x值由左到右排列，垂直：以左下角y值由下到上排列。
    4. ;;编码思路：1，利用院长外包围9点函数找到合适移动基点。2，根据对齐形式计算移动终点。3，移动命令完成最后步骤。
    5. ;;图框、方框和手工操作则利用对角点作为ssget 框选点，全选图纸内容后再做移动，排列，注意边框不要重叠，否则会错位！
    6. ;;排图纸说明：图框为块的选2操作，默认都是同名块，点选图框右键可全选，不同名块勾选异名块，单独点选；图框不为块是方框的选3，默认同层同色矩形框可以快速全选，不共性的打钩单独点选；如果连方框都没有直接用4 手动框选图纸内容，没选一次画一个矩形框，选完右键继续，勾选边框比会自动采用标准图纸比例框。
    7. ;; /ST-2020.03.06更新。
    8. ;1，增加插图框程序，根据矩形框插入指定图框块，自动缩放居中，因每种图框款式不一，需后期手动微调位置，选取操作与上面矩形框排列一样。默认图框文件是 D：\A2图框MR.dwg 左下角为插入点，要按照标准A2图幅（594x420mm）尺寸来做，不然缩放比例不对的；
    9. ;2，完善了dcl对话框程序，可记忆上次数值；
    10. ;3，补充处理因坐标系非世界系出错代码；
    11. ;4，有群组的时候框选类型会错位，未解决。
    12. ;==========================================================================
    13. ;; /ST-2020.03.09更新。
    14. ;1,处理了群组单体排列的问题；2,增加本图图框插入；
    15. ;3,增加阵列,只做了从左到右从上到下排列；
    16. ;4,增加单体速选.
    17. ;==========================================================================
    18. ;; /ST-2020.03.11更新。
    19. ;1,增加 自动/手选 顺序排列开关；2,增加复制阵列(自带那种)；
    20. ;==========================================================================
    21. ;; /ST-2020.03.13更新。选取方式增加自动识别图框。
    22. ;用于异名图框块，或者非块的矩形外框图框的速选，要全对象计算对比，大型图纸尽量不要使用，使用布局图纸空间的应该问题不大。
    23. ;==========================================================================
    24. ;; /ST-2020.03.18更新。自动识别增加速选：直接框选生成边框，大型图慎用。
    26. (defun c:tt5 () (c:ent_DQPL));;方便自己调试设的快捷键
    27. (vl-load-com)
    28. ;==========================================================================对话框程式代码（不熟不多说）
    29. (defun c:ent_DQPL (/ DCL dd ucs)
    30.     (if (= (getvar "WORLDUCS" ) 0) (if (tblsearch "ucs" "ucs_old") (command "ucs" "na" "s" "ucs_old" "y" "ucs" "w") 
    31.     (command "ucs" "na" "s" "ucs_old" "ucs" "w")) (setq ucs 1))
    32.   (setq DCL (load_dialog (make-dcl-pl))) 
    33.   (new_dialog "rect01" DCL) 
    35.     (if (not cp_xx) (setq cp_xx 0))
    36.     (if (not cp_dx) (setq cp_dx 100))
    37.     (if (not YMK_TMP) (setq YMK_TMP 0))
    38.     (if (not BGX_TMP) (setq BGX_TMP 0))
    39.     (if (not CKB_TMP) (setq CKB_TMP 0))
    40.     (if (not SX_TMP) (setq SX_TMP 0))
    41.     (if (not zdSX_TMP) (setq zdSX_TMP 0))
    42.     (if (not LB_TMP) (setq LB_TMP 1))
    44.     (if (not tukuang_TMP) (setq tukuang_TMP 1) )     
    45.     (if (not t_lujing) (setq t_lujing "D:\\A2图框MR.dwg"))
    47.     (if cp_dx1 (setq cp_xx 1 cp_dx cp_dx1 cp_dx1 nil) );判断手动点距离是否有
    48.     (if tk_BLfile  (setq t_lujing tk_BLfile))
    50.     (if (not RB_zhenlieFS) (progn (SETQ RB_zhenlieFS 1)));阵列方式默认
    52.     ;变灰判断
    53.     (if (or (= cp_xx 1) (/= LB_TMP 1)) (mode_tile "row_sxdq" 1))
    54.     (if  (= cp_xx 0)  (mode_tile "cp_d" 1))
    55.     (if  (or (= tukuang_TMP 1) (= tukuang_TMP 2))  (progn (mode_tile "k_lujing" 1) (mode_tile "k_liulan" 1)) )
    57.     (if (= RB_zhenlieFS 1) (progn (mode_tile "k_shushu" 1)  (mode_tile "k_tog_zhongdian" 0)) (progn (fuzhizhenlie) (mode_tile "k_shushu" 0)  (mode_tile "k_tog_zhongdian" 1)))
    61.     (if (not t_hengju) (setq t_hengju 100))
    62.     (if (not t_hengshu) (setq t_hengshu 3))
    63.     (if (not t_shuju) (setq t_shuju 100))
    64.     (if (not t_shushu) (setq t_shushu 3))
    65.     (if (not RB_zhenliejianju) (setq RB_zhenliejianju 1))
    67.     (if t_hengju_dx (setq t_hengju t_hengju_dx t_hengju_dx nil));手动选间距赋值函数变量，自清空
    68.     (if t_shuju_dx (setq t_shuju t_shuju_dx t_shuju_dx nil))
    70.     (if (not RB_paixuFS) (setq RB_paixuFS 1));排序方式  
    72.     (if (not t_tog_zhongdian) (setq t_tog_zhongdian 0));阵列基点默认0-左下角
    75.     (setdate)
    76.     ;;水平
    77.   (action_tile "dtpl1" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 1)")
    78.     (action_tile "dtpl2" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 2)")
    79.     (action_tile "dtpl3" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 3)")
    80.     ;;垂直
    81.     (action_tile "dtpl4" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 4)")
    82.     (action_tile "dtpl5" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 5)")
    83.     (action_tile "dtpl6" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 6)")
    84.     ;;双向
    85.     (action_tile "dtpl7" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 7)")
    86.     (action_tile "dtpl8" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 8)")
    87.     (action_tile "dtpl9" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 9)")
    88.     (action_tile "dtpl10" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 10)")
    89.     (action_tile "dtpl11" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 11)")
    90.     (action_tile "dtpl12" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 12)")
    91.   (action_tile "dtpl13" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 13)")
    92.     (action_tile "dtpl14" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 14)")
    93.     (action_tile "dtpl15" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 15)")
    94.     ;;重排    
    95.     (action_tile "dxjj" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 16)"); 排列点选距离
    96.     (action_tile "k_liulan" "(S_RECT) (S_PGON) (S_toggle) (setq t_moren 0) (done_dialog 17)");浏览
    97.     (action_tile "k_ctk" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 18)");插图框确认键
    99.     (action_tile "k_zlqueding" "(S_RECT) (S_PGON) (S_toggle) (if  (or (= t_hengshu 0) (= t_shushu 0)) (alert \"输入数据有误！\")  (done_dialog 19))");阵列确定按键 
    101.     (action_tile "k_bt_dianxuan" "(S_RECT) (S_PGON) (S_toggle) (done_dialog 20)");阵列点选距离
    103.     ;--------------------------------------------------------------------------------非done项目
    104.     (ACTION_TILE "xlb2" "(MODE_TILE \"row_sxdq\" 1)");变灰    
    105.     (ACTION_TILE "xlb3" "(MODE_TILE \"row_sxdq\" 1)");变灰
    106.     (ACTION_TILE "xlb4" "(MODE_TILE \"row_sxdq\" 1)");变灰
    107.     (ACTION_TILE "xlb5" "(MODE_TILE \"row_sxdq\" 1)");变灰
    108.     (ACTION_TILE "xlb1" "(S_RECT) (if (= cp_xx 0) (MODE_TILE \"row_sxdq\" 0))");恢复    
    109.     (action_tile "cp_x" "(S_RECT) (if (= cp_xx 1) (progn (mode_tile \"cp_d\" 0) (mode_tile \"row_sxdq\" 1)) (progn (mode_tile \"cp_d\" 1) (if (= xlb1 1) (mode_tile \"row_sxdq\" 0))))")
    110.     (action_tile "k_moren" "(S_RECT) (mode_tile \"k_lujing\" 1) (mode_tile \"k_liulan\" 1)")
    111.     (action_tile "k_tuzhong" "(S_RECT) (mode_tile \"k_lujing\" 1) (mode_tile \"k_liulan\" 1)")
    112.     (action_tile "k_chawenjian" "(S_RECT) (mode_tile \"k_lujing\" 0) (mode_tile \"k_liulan\" 0)")
    113.     ;(action_tile "k_zlqueding" "(S_RECT) (S_PGON) (S_toggle) (if  (= t_hengshu 0) (alert \"输入数据有误！\") )")
    114.     (action_tile "k_rb_chongpaizhenlie" "(S_RECT) (chongpaizhenlie) (mode_tile \"k_shushu\" 1) (mode_tile \"k_rb_zuoxia\" 0) (mode_tile \"k_tog_zhongdian\" 0) (mode_tile \"k_paixuFS\" 0)")
    115.     (action_tile "k_rb_fuzhizhenlie" "(S_RECT) (fuzhizhenlie) (mode_tile \"k_shushu\" 0) (mode_tile \"k_rb_zuoxia\" 1) (mode_tile \"k_tog_zhongdian\" 1) (mode_tile \"k_paixuFS\" 1)")
    116.     ;--------------------------------------------------------------------------------
    118.     (setq dd (start_dialog ))
    119.     (cond
    121.             ((= dd 1) (cond ((= LB_TMP 1) (if (= cp_xx 1) (S_PLcx 0 7 9 0) (S_DQcx 0 9)));单体
    122.                                   ((= LB_TMP 2) (if (= cp_xx 1) (tukuang_BK 0 x 7 9 0) (tukuang_BK 0 9 x x x)));图框块
    123.                                     ((= LB_TMP 3) (if (= cp_xx 1) (juxing_WL 0 x 7 9 0) (juxing_WL 0 9 x x x)));矩形框
    124.                                   ((= LB_TMP 4) (if (= cp_xx 1) (select_SG 0 x 7 9 0) (select_SG 0 9 x x x)));手工选
    125.                                         ((= LB_TMP 5) (if (= cp_xx 1) (zidongshibie_WL 0 x 7 9 0) (zidongshibie_WL 0 9 x x x)));自动识别
    126.                             ))         
    127.             ((= dd 2) (cond ((= LB_TMP 1) (if (= cp_xx 1) (S_PLcx 0 4 6 0) (S_DQcx 0 5)));单体
    128.                                   ((= LB_TMP 2) (if (= cp_xx 1) (tukuang_BK 0 x 4 6 0) (tukuang_BK 0 5 x x x)));图框块
    129.                                     ((= LB_TMP 3) (if (= cp_xx 1) (juxing_WL 0 x 4 6 0) (juxing_WL 0 5 x x x)));矩形框
    130.                                   ((= LB_TMP 4) (if (= cp_xx 1) (select_SG 0 x 4 6 0) (select_SG 0 5 x x x)));手工选
    131.                                         ((= LB_TMP 5) (if (= cp_xx 1) (zidongshibie_WL 0 x 4 6 0) (zidongshibie_WL 0 5 x x x)));自动识别
    132.                             ))
    134.                 ((= dd 3) (cond ((= LB_TMP 1) (if (= cp_xx 1) (S_PLcx 0 1 3 0) (S_DQcx 0 1)));单体
    135.                                   ((= LB_TMP 2) (if (= cp_xx 1) (tukuang_BK 0 x 1 3 0) (tukuang_BK 0 1 x x x)));图框块
    136.                                     ((= LB_TMP 3) (if (= cp_xx 1) (juxing_WL 0 x 1 3 0) (juxing_WL 0 1 x x x)));矩形框
    137.                                   ((= LB_TMP 4) (if (= cp_xx 1) (select_SG 0 x 1 3 0) (select_SG 0 1 x x x)));手工选
    138.                                         ((= LB_TMP 5) (if (= cp_xx 1) (zidongshibie_WL 0 x 1 3 0) (zidongshibie_WL 0 1 x x x)));自动识别
    139.                             ))
    143.         ((= dd 4) (cond ((= LB_TMP 1) (if (= cp_xx 1) (S_PLcx 1 1 7 (* 0.5 pi)) (S_DQcx 1 1)));单体
    144.                                   ((= LB_TMP 2) (if (= cp_xx 1) (tukuang_BK 1 x 1 7 (* 0.5 pi)) (tukuang_BK 1 1 x x x)));图框块
    145.                                     ((= LB_TMP 3) (if (= cp_xx 1) (juxing_WL 1 x 1 7 (* 0.5 pi)) (juxing_WL 1 1 x x x)));矩形框
    146.                                   ((= LB_TMP 4) (if (= cp_xx 1) (select_SG 1 x 1 7 (* 0.5 pi)) (select_SG 1 1 x x x)));手工选
    147.                                     ((= LB_TMP 5) (if (= cp_xx 1) (zidongshibie_WL 1 x 1 7 (* 0.5 pi)) (zidongshibie_WL 1 1 x x x)));自动识别
    148.                             ))
    150.         ((= dd 5) (cond ((= LB_TMP 1) (if (= cp_xx 1) (S_PLcx 1 2 8 (* 0.5 pi)) (S_DQcx 1 5)));单体
    151.                                   ((= LB_TMP 2) (if (= cp_xx 1) (tukuang_BK 1 x 2 8 (* 0.5 pi)) (tukuang_BK 1 5 x x x)));图框块
    152.                                     ((= LB_TMP 3) (if (= cp_xx 1) (juxing_WL 1 x 2 8 (* 0.5 pi)) (juxing_WL 1 5 x x x)));矩形框
    153.                                   ((= LB_TMP 4) (if (= cp_xx 1) (select_SG 1 x 2 8 (* 0.5 pi)) (select_SG 1 5 x x x)));手工选    
    154.                                     ((= LB_TMP 5) (if (= cp_xx 1) (zidongshibie_WL 1 x 2 8 (* 0.5 pi)) (zidongshibie_WL 1 5 x x x)));自动识别    
    155.                             ))
    157.         ((= dd 6) (cond ((= LB_TMP 1) (if (= cp_xx 1) (S_PLcx 1 3 9 (* 0.5 pi)) (S_DQcx 1 9)));单体
    158.                                   ((= LB_TMP 2) (if (= cp_xx 1) (tukuang_BK 1 x 3 9 (* 0.5 pi)) (tukuang_BK 1 9 x x x)));图框块
    159.                                     ((= LB_TMP 3) (if (= cp_xx 1) (juxing_WL 1 x 3 9 (* 0.5 pi)) (juxing_WL 1 9 x x x)));矩形框
    160.                                   ((= LB_TMP 4) (if (= cp_xx 1) (select_SG 1 x 3 9 (* 0.5 pi)) (select_SG 1 9 x x x)));手工选    
    161.                                     ((= LB_TMP 5) (if (= cp_xx 1) (zidongshibie_WL 1 x 3 9 (* 0.5 pi)) (zidongshibie_WL 1 9 x x x)));自动识别
    162.                             ))    
    164.         ((= dd 7) (S_DQcx 2 7))
    165.         ((= dd 8) (S_DQcx 2 4))
    166.         ((= dd 9) (S_DQcx 2 1))
    167.         ((= dd 10) (S_DQcx 2 8))
    168.         ((= dd 11) (S_DQcx 2 5))
    169.         ((= dd 12) (S_DQcx 2 2))
    170.         ((= dd 13) (S_DQcx 2 9))
    171.         ((= dd 14) (S_DQcx 2 6))
    172.         ((= dd 15) (S_DQcx 2 3))
    174.         ((= dd 16) (S_RECT2)) ;;排列点选间距
    175.         ((= dd 17) (setq tk_BLfile (getfiled "选择图框文件" "C:/Users/Administrator/Desktop/" "dwg" 16)) (c:ent_DQPL))
    176.         ((= dd 18) (cond  ((= tukuang_TMP 1) (chatukuang "D:\\A2图框MR.dwg"))
    177.                                                ((= tukuang_TMP 2) (chatukuang_tuzhong))
    178.                                                ((= tukuang_TMP 3) (chatukuang t_lujing))))
    180.         ((= dd 19)  (if (= RB_zhenlieFS 1) (if (= LB_TMP 1) (cond  ((= RB_zhenliejianju 1) ( zhenlie_DT t_hengju t_shuju t_hengshu 1))
    181.                                                                                    ((= RB_zhenliejianju 2) ( zhenlie_DT t_hengju t_shuju t_hengshu 2)))
    182.                                                                         (cond  ((= RB_zhenliejianju 1) ( zhenlie_SS t_hengju t_shuju t_hengshu 1))
    183.                                                                                    ((= RB_zhenliejianju 2) ( zhenlie_SS t_hengju t_shuju t_hengshu 3)))
    184.                                                      );if1
    185.                       (zhenlie_FUZHI t_shushu  t_hengshu  t_shuju  t_hengju)
    186.                                 );if2
    189.         )
    190.         ((= dd 20)    (S_RECT3))    ;;阵列点选间距                    
    193.     );cond
    194.     (if (not ucs) (command "ucs" "na" "r" "ucs_old"))
    195.   (princ)
    196. )
    197. ;==========================================================================辅助函数
    198. ;;提取勾选键、排距数值
    199. (DEFUN S_RECT()
    200.     (SETQ cp_dx (ABS (ATOF (GET_TILE "cp_d"))) ;间距值
    201.         cp_xx (atoi (GET_TILE "cp_x")) ;重排开关值
    202.       xlb1  (atoi (GET_TILE "xlb1")));类别开关值
    203.         ;t_moren  (atoi (GET_TILE "k_moren"));默认图框开关值
    204.         (COND ((= (GET_TILE "k_moren") "1") (SETQ tukuang_TMP 1))
    205.           ((= (GET_TILE "k_tuzhong") "1") (SETQ tukuang_TMP 2))
    206.             ((= (GET_TILE "k_chawenjian") "1") (SETQ tukuang_TMP 3))
    207.        );图框类别     
    208.     (setq t_hengju (ATOF (GET_TILE "k_hengju")) 
    209.             t_hengshu (atoi (GET_TILE "k_hengshu"))
    210.           t_shuju (ATOF (GET_TILE "k_shuju"))
    211.                 t_shushu (atoi (GET_TILE "k_shushu"))
    212.         )
    213.      (COND ((= (GET_TILE "k_rb_zhongzhong") "1") (SETQ RB_zhenliejianju 1))
    214.            ((= (GET_TILE "k_rb_bianbian") "1") (SETQ RB_zhenliejianju 2))
    216.        );阵列间距方式 
    217.        (COND ((= (GET_TILE "k_rb_zidong") "1") (SETQ RB_paixuFS 1))
    218.            ((= (GET_TILE "k_rb_xuanxu") "1") (SETQ RB_paixuFS 2))
    220.        );排序方式
    221.        (COND ((= (GET_TILE "k_rb_chongpaizhenlie") "1") (SETQ RB_zhenlieFS 1))
    222.            ((= (GET_TILE "k_rb_fuzhizhenlie") "1") (SETQ RB_zhenlieFS 2))
    224.        );阵列方式 t_tog_zhongdian
    226.     (setq t_tog_zhongdian (atoi (GET_TILE "k_tog_zhongdian")));阵列对齐基点
    228. )
    229. (defun S_RECT2 (/ pdx1);;选点定距函数(排列)
    230.     (setq cp_dx1 (distance (setq pdx1(getpoint)) (getpoint pdx1)))
    231.       (c:ent_DQPL)
    232. )
    233. (defun S_RECT3 (/ pdx1);;选点定距函数(阵列); 
    234.     (setq p1(getpoint "\n选取1点：") p2 (getcorner p1"\n选取2点(X差=横距，Y差=竖距)："))
    235.     (setq t_hengju_dx (abs (- (car p1) (car p2))) t_shuju_dx (abs (- (cadr p1) (cadr p2))))
    236.       (c:ent_DQPL)
    237. )
    238. ;; 院长函数 / 外包盒9点坐标；在此程序中发挥关键作用
    239. (defun ss9pt (ss n / ss i s1 ll rr box ptn a p1 p2 p3 p4 p5 p6 p7 p8 p9)
    241.     (progn ss
    242.       (setq i -1)
    243.       (repeat (sslength ss)
    244.                 (setq s1 (ssname ss (setq i (1+ i))))
    245.                 (vla-GetBoundingBox (vlax-ename->vla-object s1) 'll 'rr)
    246.                 (setq box (list (vlax-safearray->list ll) (vlax-safearray->list rr))
    247.                     ptn (append box ptn)
    248.                 )
    249.       )
    250.       (setq a  (mapcar '(lambda (x) (apply 'mapcar (cons x ptn))) (list 'min 'max))
    251.                 p1 (car a)
    252.                 p9 (cadr a)
    253.                 p5 (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p9)
    254.                 p2 (list (car p5) (cadr p1))
    255.                 p3 (list (car p9) (cadr p1))
    256.                 p4 (list (car p1) (cadr p5))
    257.                 p6 (list (car p9) (cadr p5))
    258.                 p7 (list (car p1) (cadr p9))
    259.                 p8 (list (car p5) (cadr p9))
    260.       )
    261.       (nth (- n 1) (list p1 p2 p3 p4 p5 p6 p7 p8 p9))
    262.     )
    263.   )
    264. ;;选择集=>>名表
    265. (defun SStoLST (ss / i entname lst)
    266.     (setq i -1)
    267.     (if ss
    268.         (while (setq entname (ssname ss(setq i(1+ i))))
    269.             (setq lst (cons entname lst))))
    270.     (reverse lst)
    271. )
    273. (defun setdate ();;设置dcl各个值 
    274.     (set_tile "cp_x" (rtos cp_xx 2 2))
    275.     (set_tile "cp_d" (rtos cp_dx 2 2))
    276.     (set_tile "toggle_ymk" (rtos YMK_TMP 2 2))
    277.     (set_tile "toggle_bgx" (rtos BGX_TMP 2 2))
    278.     (set_tile "toggle_ckb" (rtos CKB_TMP 2 2)) 
    279.     (set_tile "toggle_sx" (rtos SX_TMP 2 2))
    280.     (set_tile "toggle_sx2" (rtos zdSX_TMP 2 2))
    282.     (cond  ((= LB_TMP 1) (set_tile "xlb1" "1"))
    283.              ((= LB_TMP 2) (set_tile "xlb2" "1"))
    284.              ((= LB_TMP 3) (set_tile "xlb3" "1"))
    285.              ((= LB_TMP 4) (set_tile "xlb4" "1"))
    286.              ((= LB_TMP 5) (set_tile "xlb5" "1"))
    287.     )
    288.     (cond  ((= tukuang_TMP 1) (set_tile "k_moren" "1"))
    289.              ((= tukuang_TMP 2) (set_tile "k_tuzhong" "1"))
    290.              ((= tukuang_TMP 3) (set_tile "k_chawenjian" "1"))             
    291.     )
    292.     (set_tile "k_lujing" t_lujing)
    294.     (set_tile "k_hengju" (rtos t_hengju 2 2))
    295.     (set_tile "k_hengshu" (rtos t_hengshu 2 0))
    296.     (set_tile "k_shuju" (rtos t_shuju 2 2))
    297.     (set_tile "k_shushu" (rtos t_shushu 2 0))
    298.     (cond  ((= RB_zhenliejianju 1) (set_tile "k_rb_zhongzhong" "1"))
    299.              ((= RB_zhenliejianju 2) (set_tile "k_rb_bianbian" "1"))            
    300.     );阵列间距方式
    301.     (cond  ((= RB_paixuFS 1) (set_tile "k_rb_zidong" "1"))
    302.              ((= RB_paixuFS 2) (set_tile "k_rb_xuanxu" "1"))            
    303.     );排序方式
    304.      (cond  ((= RB_zhenlieFS 1) (set_tile "k_rb_chongpaizhenlie" "1"))
    305.              ((= RB_zhenlieFS 2) (set_tile "k_rb_fuzhizhenlie" "1"))            
    306.     );阵列方式
    307.     (set_tile "k_tog_zhongdian" (rtos t_tog_zhongdian 2 2));阵列对齐基点-默认左下角
    309. )
    311. (defun fuzhizhenlie ();点复制阵列选项变灰处理 
    312. (mode_tile "k_no1" 1)    
    313.     (mode_tile "k_no2" 1)
    314.     (mode_tile "k_shuipingduiqi" 1)
    315.     (mode_tile "k_chuizhiduiqi" 1)
    316.     (mode_tile "k_dengju,dianxuan" 1)
    317.     ;(mode_tile "k_zlqueding" 1)
    318.     (mode_tile "row_sxdq" 1)
    319. )
    320. (defun chongpaizhenlie ();点重排阵列选项变亮处理 
    321. (S_PGON) (S_RECT)    
    322. (mode_tile "k_no1" 0)    
    323.     (mode_tile "k_no2" 0)
    324.     (mode_tile "k_shuipingduiqi" 0)
    325.     (mode_tile "k_chuizhiduiqi" 0)
    326.     (mode_tile "k_dengju,dianxuan" 0)    
    327.     ;(mode_tile "k_zlqueding" 0)
    328.     (if (and (= LB_TMP 1) (= cp_xx 0)) (mode_tile "row_sxdq" 0))
    329. )
    330. ;==========================================================================主处理函数
    331. ;;单体对齐主程序,/ H-S=0：水平 / H-S=1：垂直 / H-S=2:双向 / 9NB:移动基点 /
    332. (defun S_DQcx (H-S 9NB / ang entdate entname gpname gpname_lst gpss_lst gx_list i nb nb0 p0 p1 p1a p2 pick_date ss ss_gp ss_gp_temp ss-9 ssall sslst sslst_px)
    333.     (command "undo" "be");撤销开始点，对于批量操作做好撤销设置，不然一步步后退很麻烦。
    334.     (prompt "\n选择对象:"); ssget 后面不能带操作说明，在其前可以用 prompt 先行提示。
    337.     (if (= SX_TMP 1)
    338.           (progn (setq  pick_date (entget (car (entsel "\n点选源对象:"))) GX_list '())
    340.                     (if (= (cdr (assoc 0 pick_date)) "INSERT")  
    341.                         (setq  GX_list (list (assoc 0 pick_date) (assoc 2 pick_date)));图块类
    342.                         (progn (setq  GX_list (list (assoc 0 pick_date) (assoc 8 pick_date))) (if (assoc 62 pick_date) (setq GX_list (cons  (assoc 62 pick_date) GX_list))));其他类
    344.                     );;收集共性组码
    346.             (prompt "\n选择要处理对象 / 全选<空格>：")
    347.             (if (not (setq ssall (ssget GX_list))) (setq ssall (ssget "x"  GX_list)));;共性选集(同层、同色)
    349.                   (sssetfirst nil ssall)
    350.             (setq  ss_gp (ssadd) ss (ssadd))
    352.             );progn
    354.     (setq ssall (ssget) ss_gp (ssadd) ss (ssadd)));if ;ss_gp:全部属于群组成员的选集
    356.     ;;判断群组
    357.     ;▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
    358.     (setq i -1 GPname_lst '()) 
    359.     (while (setq entname (ssname ssall (setq i (1+ i))))      
    360.      (if (= (cdr (assoc 102 (setq entdate (entget entname)))) "{ACAD_REACTORS") (progn (setq GPname (cdr (assoc 330 entdate))) (setq ss_gp (ssadd entname ss_gp))) (setq ss (ssadd entname ss)))
    361.      (if (not (member GPname GPname_lst)) (setq GPname_lst (cons GPname GPname_lst)));群组名的表
    362.     );while 
    363.     ;(sssetfirst nil ss);亮显ss
    364.     ;▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
    365.     ;; 单体ss选集处理
    366.   (setq p0 (getpoint "\n选择对齐基点<退出>: "));getpoint 等很多函数后面可以接说明，\n 换行号，命令行会换一行再提示。
    367.   (setq i -1);为了配合下面 ssname 函数设的变量，第一个对象编号为 0，所以设为 -1。
    368.     (while (setq entname (ssname ss (setq i (1+ i))));while 对选集全部对象做循环处理，也可以用 repeat 函数来做。
    369.         (setq ss-9 (ssadd) ss-9 (ssadd entname ss-9))
    370.         (setq  p1 (ss9pt ss-9 9NB));9NB是此函数参数之一，就是对象的9点之一（移动基点p1），根据对齐形式选取。
    371.         (cond ((= H-S 0) (setq p2 (list (car p1) (cadr p0))));H-S也是参数之一，根据他来计算移动的目标点 p2
    372.             ((= H-S 1) (setq p2 (list (car p0) (cadr p1))))
    373.             ((= H-S 2) (setq p2 p0));双向对齐时，选的点p0就是目标点p2
    374.         )
    375.         (command "MOVE" entname "" "non" p1 "non" p2);移动命令完成
    376.     );while
    377.     ;▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
    378.     ;;群组对象处理：
    379.     (if ss_gp (progn 
    380.                             (setq GPss_lst '());GPss_lst-各组对象选集 列表 
    381.                             (foreach x GPname_lst
    382.                                   (setq i -1 ss_gp_temp (ssadd)) ;ss_gp_temp-临时选集 
    383.                                 (while (setq entname (ssname ss_gp (setq i (1+ i))))      
    384.                                     (if (equal (cdr (assoc 330  (entget entname))) x) (setq ss_gp_temp (ssadd entname ss_gp_temp)))                
    385.                                 );while
    386.                                 (setq GPss_lst (cons ss_gp_temp GPss_lst))            
    387.                             );foreach1                                                                            
    389.                             (foreach x GPss_lst
    391.                                 (if (/= (sslength x) 0)
    392.                                     (progn (setq  p1 (ss9pt x 9NB)) 
    393.                                   (cond ((= H-S 0) (setq p2 (list (car p1) (cadr p0)))) 
    394.                                         ((= H-S 1) (setq p2 (list (car p0) (cadr p1))))
    395.                                         ((= H-S 2) (setq p2 p0)) 
    396.                                   )
    397.                                 (command "MOVE" x "" "non" p1 "non" p2) ))
    399.                             );foreach2    
    401.                         );progn
    402.     );if
    403.  ; ▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼    
    404.     (command "undo" "e");撤销结束点，与开始点之间的操作一步撤销完成
    405.     (princ);这个是标配吧
    406. );结束
    407. ;==========================================================================
    408. ;;单体排列主程序,/ H-S=0：水平 / H-S=1：垂直 / ang:水平0，垂直90° / NB:对象移动基点 / NB0: 移动目标点(选取合适的9点之一来计算)
    409. (defun S_PLcx (H-S NB NB0 ang / entname i p0 p1a ss sslst sslst_px ss-9)
    410.   (command "undo" "be");同上
    412.     (if (= SX_TMP 1)
    413.           (progn (setq  pick_date (entget (car (entsel "\n点选源对象:"))) GX_list '())
    415.                     (if (= (cdr (assoc 0 pick_date)) "INSERT")  
    416.                         (setq  GX_list (list (assoc 0 pick_date) (assoc 2 pick_date)));图块类
    417.                         (progn (setq  GX_list (list (assoc 0 pick_date) (assoc 8 pick_date))) (if (assoc 62 pick_date) (setq GX_list (cons  (assoc 62 pick_date) GX_list))));其他类
    419.                     );;收集共性组码
    421.             (prompt "\n选择要处理对象 / 全选<空格>：")
    422.             (if (not (setq ssall (ssget GX_list))) (setq ssall (ssget "x"  GX_list)));;共性选集(同层、同色)
    424.                   (sssetfirst nil ssall)
    425.             (setq  ss_gp (ssadd) ss (ssadd))
    427.             );progn
    429.     (setq ssall (ssget) ss_gp (ssadd) ss (ssadd)));if ;ss_gp:全部属于群组成员的选集
    431.     ;;判断群组
    432.     ;▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼     
    433.     (setq i -1 GPname_lst '()) 
    434.     (while (setq entname (ssname ssall (setq i (1+ i))))      
    435.      (if (= (cdr (assoc 102 (setq entdate (entget entname)))) "{ACAD_REACTORS") (progn (setq GPname (cdr (assoc 330 entdate))) (setq ss_gp (ssadd entname ss_gp))) (setq ss (ssadd entname ss)))
    436.      (if (not (member GPname GPname_lst)) (setq GPname_lst (cons GPname GPname_lst)));群组名的表
    437.     );while
    438.     ;▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
    439.     ;; 单体ss选集处理        
    440.     (setq p0 (getpoint "\n选择对齐基点<退出>: "));排列的起点
    441.     (setq sslst (SStoLST ss));;选集转成表以便下面进行排序
    442.     ;等距排列其实跟上面对齐操作原理一样，但是要对选集对象排序一下，不然会乱，因为这里的移动终点是根据前对象计算的，而对齐只要根据自己点位计算就行。
    444. ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    445.     (if (= RB_paixuFS 1) (cond ((= H-S 0) (setq sslst_px (vl-sort sslst '(lambda (a b) (< (car (car (enbox a))) (car (car (enbox b))))))));;横排时按对象1点的x值小到大排序，得到新表
    446.                                   ((= H-S 1) (setq sslst_px (vl-sort sslst '(lambda (a b) (< (cadr (car (enbox a))) (cadr (car (enbox b))))))));;竖排时按对象1点的y值小到大排序，得到新表
    447.                          );cond  自动排列
    449.         (setq sslst_px sslst);;按选择顺序排列
    450.     );if
    453. ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■    
    454.     (setq i 0);这里循环设的i是0，和上面-1是一样效果，都是从编号0开始
    455.     (repeat (length sslst_px);这里用了repeat函数，注意这里对象是表，对比一下上面 while 的对象是选集，会发现原理一样，但用到的函数不一样
    456.         (setq entname (nth i sslst_px)) 
    457.             (setq ss-9 (ssadd) ss-9 (ssadd entname ss-9)
    458.                   p1a (ss9pt ss-9 NB));移动基点
    460.         (command "MOVE" entname "" "non" p1a "non" p0);移动命令
    461.         ;(if (not cp_dx1) (setq cp_dx1 cp_dx));这是对话框的一些代码
    463.         (setq p0 (polar (ss9pt ss-9 NB0) ang cp_dx) i (1+ i))    ;这里是计算下一个对象的移动终点(p0重新赋值，循环使用)
    464.     );repeat
    465.     ;▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
    466.     ;;群组对象处理：
    467.     (if ss_gp (progn                                                                          
    468.                             (setq GPss_lst '());GPss_lst-各组对象选集 列表 
    470.                             (foreach x GPname_lst
    471.                                   (setq i -1 ss_gp_temp (ssadd)) ;ss_gp_temp-临时选集 
    472.                                 (while (setq entname (ssname ss_gp (setq i (1+ i))))      
    473.                                     (if (equal (cdr (assoc 330  (entget entname))) x) (setq ss_gp_temp (ssadd entname ss_gp_temp)))                
    474.                                 );while
    475.                                 (if (/= (sslength ss_gp_temp) 0) (setq GPss_lst (cons ss_gp_temp GPss_lst)))            
    476.                             );foreach1                                                                            
    478.                                 (cond ((= H-S 0) (setq sslst_px (vl-sort GPss_lst '(lambda (a b) (< (car (ss9pt a 1)) (car (ss9pt b 1)))))));;横排时按对象1点的x值小到大排序，得到新表
    479.                           ((= H-S 1) (setq sslst_px (vl-sort GPss_lst '(lambda (a b) (< (cadr (ss9pt a 1)) (cadr (ss9pt b 1)))))));;竖排时按对象1点的y值小到大排序，得到新表
    480.                   );cond
    481.                             (princ GPss_lst    ) (princ)
    482.                             (setq i 0) 
    483.                 (repeat (length sslst_px)
    484.                          (setq entname (nth i sslst_px))                           
    485.                            (if (/= (sslength entname) 0)      
    486.                                               (progn (setq  p1a (ss9pt entname NB))         
    487.                             (command "MOVE" entname "" "non" p1a "non" p0) 
    488.                                       (setq p0 (polar (ss9pt entname NB0) ang cp_dx)));progn
    489.                                      );if
    490.                                             (setq i (1+ i))
    491.                             );repeat                                                        
    492.                     );progn
    493.     );if
    494. ;▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼            
    495.     (command "undo" "e");同上
    496.     ;(setq cp_dx1 nil);这是对话框的
    497.     (princ)
    498. )
    501. ;; 更新补充代码0303 ◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆
    503. ;==========================================================================辅助函数
    504. (DEFUN S_PGON () ;;类别选择函数
    505.  (COND ((= (GET_TILE "xlb1") "1") (SETQ LB_TMP 1))
    506.        ((= (GET_TILE "xlb2") "1") (SETQ LB_TMP 2))
    507.          ((= (GET_TILE "xlb3") "1") (SETQ LB_TMP 3))
    508.          ((= (GET_TILE "xlb4") "1") (SETQ LB_TMP 4))
    509.          ((= (GET_TILE "xlb5") "1") (SETQ LB_TMP 5))
    510.  )    
    511. )
    513. (DEFUN S_toggle () ;;速选、异名块、不共性、长宽比 勾选开关函数 
    514.  (COND ((= (GET_TILE "toggle_ymk") "1") (SETQ YMK_TMP 1))
    515.        ((= (GET_TILE "toggle_ymk") "0") (SETQ YMK_TMP 0))
    517.  ) 
    518.  (COND ((= (GET_TILE "toggle_bgx") "1") (SETQ BGX_TMP 1))
    519.          ((= (GET_TILE "toggle_bgx") "0") (SETQ BGX_TMP 0))
    520.  )
    521.  (COND ((= (GET_TILE "toggle_ckb") "1") (SETQ CKB_TMP 1))
    522.          ((= (GET_TILE "toggle_ckb") "0") (SETQ CKB_TMP 0))
    523.  )
    524.  (COND ((= (GET_TILE "toggle_sx") "1") (SETQ SX_TMP 1))
    525.          ((= (GET_TILE "toggle_sx") "0") (SETQ SX_TMP 0))
    526.  )
    527.  (COND ((= (GET_TILE "toggle_sx2") "1") (SETQ zdSX_TMP 1))
    528.          ((= (GET_TILE "toggle_sx2") "0") (SETQ zdSX_TMP 0))
    529.  )
    530. )
    532. (defun enbox (ename / ll ur);单体外框对角点函数 
    533.     (vla-getboundingbox (vlax-ename->vla-object ename) 'll 'ur)
    534.     (mapcar 'vlax-safearray->list (list ll ur)))
    536. (defun DQ_BK (SS_lst H-S 9NB / i p0 p1 p2 ss-name ss-9);选集类别-对齐函数
    537. (setq p0 (getpoint "\n选择对齐基点<退出>: "))
    538. (command "-layer" "u" (setq suo_str (layer_suo_str)) "");开锁
    539.  (setq i -1)    
    540. (while (setq ss-name (car (nth (setq i (1+ i)) SS_lst)));提取表元素中的 选集
    541.     (setq ss-9 (ssadd) ss-9 (ssadd (caddr (nth i SS_lst)) ss-9))
    542.         (setq  p1 (ss9pt ss-9 9NB));9NB是此函数参数之一，就是对象的9点之一（移动基点p1），根据对齐形式选取。
    543.         (cond ((= H-S 0) (setq p2 (list (car p1) (cadr p0))));H-S也是参数之一，根据他来计算移动的目标点 p2
    544.                 ((= H-S 1) (setq p2 (list (car p0) (cadr p1))))
    545.                 ((= H-S 2) (setq p2 p0));双向对齐时，选的点p0就是目标点p2
    546.         )
    547.         (command "MOVE" ss-name "" "non" p1 "non" p2);移动命令完成
    548.     );while     
    549.     (command "-layer" "lo"  suo_str  "");回上锁    
    550. )
    552. (defun PL_BK (SS_lst H-S NB NB0 ang / i p0 p1a ss-name ss-9);选集类别-排列函数
    553. (setq p0 (getpoint "\n选择对齐基点<退出>: "))
    554. (command "-layer" "u" (setq suo_str (layer_suo_str)) "");开锁    
    555.  (setq i -1)    
    556. (while (setq ss-name (car (nth (setq i (1+ i)) SS_lst)));提取表元素中的 选集
    557.     (setq ss-9 (ssadd) ss-9 (ssadd (caddr (nth i SS_lst)) ss-9))
    558.         (setq  p1a (ss9pt ss-9 NB))
    560.         (command "MOVE" ss-name "" "non" p1a "non" p0);移动命令完成
    562.       ;(if (not cp_dx1) (setq cp_dx1 cp_dx));这是对话框的一些代码
    564.         (setq p0 (polar (ss9pt ss-9 NB0) ang cp_dx))    ;这里是计算下一个对象的移动终点(p0重新赋值，循环使用)
    565.     );while 
    566. (command "-layer" "lo"  suo_str  "");回上锁    
    567. (princ)    
    568. )
    570. (defun mid_pt (p1 p2);;中心函数
    571.  (mapcar'*(mapcar'+ p1 p2)'(0.5 0.5 0.5))
    572. )
    574. (defun ckb_rec (p1 p2 / p1x p1y p2x p2y p3 rec ss-9);;手工选择勾选长宽比处理矩形函数
    575. (setq p1x (car p1) p1y (cadr p1)
    576.           p2x (car p2) p2y (cadr p2)
    577. )
    578. (if (<= (abs (/ (- p2x p1x) 420)) (abs (/ (- p1y p2y) 297)))
    579.     (setq p3 (polar (polar p1 0 (abs (* (/ (- p1y p2y) 297) 420))) (* 1.5 pi) (abs(- p1y p2y))))
    580.     (setq p3  (polar (polar p1 0 (abs(- p2x p1x))) (* 1.5 pi) (abs (/ (* (- p2x p1x) 297) 420))))    
    581. );if    
    582. (command "RECTANG" "non" p1 "non" p3 "CHANGE" (setq rec (entlast)) "" "p" "c" 224 "")    
    583. (setq ss-9 (ssadd) ss-9 (ssadd rec ss-9))    
    584. (command "MOVE" rec "" "non" (ss9pt ss-9 5) "non" (mid_pt p1 p2))
    585. rec    
    586. )
    588. (defun layer_suo_str (/ laylst_suo lays_jh str);;上锁图层名字字符串组合
    589.   (setq lays_jh (vla-get-layers (vla-get-activedocument (vlax-get-Acad-Object))));文档图层集合
    590.   (vlax-for x lays_jh
    591.             (if (= (vla-get-lock x) :vlax-true)        
    592.         (SETQ laylst_suo (APPEND laylst_suo (LIST (vla-get-Name x)))));上锁的图层名表
    593.   )
    594.       (setq str "")
    595.      (foreach x laylst_suo
    596.         (setq str (strcat "," x str))
    597.      )
    598.     (substr str 2)
    599. )
    601. (defun chatukuang (tk_blfile / entname gx_list i pick_date pt scale ss_tk ss-9 ss-9a );;插图框主函数
    602.     (command "undo" "be")
    603.     ;(setq tk_BLfile (getfiled "选择图框文件" "" "dwg" 8))
    604.     (setvar "INSUNITS" 4)
    605.     (setq  pick_date (entget (car (entsel "\n点选矩形框:"))) GX_list '() GX_list (list (assoc 0 pick_date) (assoc 8 pick_date) (assoc 70 pick_date))) (if (assoc 62 pick_date) (setq GX_list (cons  (assoc 62 pick_date) GX_list)))
    606.     (prompt "\n选择要处理对象 / 全选<空格>：")
    607.     (if (not (setq ss_tk (ssget GX_list))) (setq ss_tk (ssget "x"  GX_list)))
    608.     (setq i -1) 
    609.     (while (setq entname (ssname ss_tk (setq i (1+ i))))
    610.         (setq ss-9 (ssadd) ss-9 (ssadd entname ss-9) pt (ss9pt ss-9 1))
    611.         (if (<= (/ (distance (ss9pt ss-9 1) (ss9pt ss-9 3)) (distance (ss9pt ss-9 1) (ss9pt ss-9 7))) (/ 594. 420)) (setq scale (/ (distance (ss9pt ss-9 1) (ss9pt ss-9 7)) 420.))  (setq scale (/ (distance (ss9pt ss-9 1) (ss9pt ss-9 3)) 594.)));if
    612.         (command "INSERT" tk_BLfile "non" pt scale "" 0  "move" (setq ss-9a (ssadd) ss-9a (ssadd (entlast) ss-9a)) "" "non" (ss9pt ss-9a 5) "non" (ss9pt ss-9 5))
    613.         (entdel entname)
    614.     );while    
    615.     (command "undo" "e")
    616.     (princ)
    617. )
    619. (defun chatukuang_tuzhong (/ entname gx_list i pick_date pt5a pt5b scale ss_tk ss-9 tukuang_block);;插图框主函数-图中块
    620.     (command "undo" "be")
    621.     (setq tukuang_block (ssget ":s" (list '(0 . "insert"))) pt5a (ss9pt tukuang_block 5))
    622.     (sssetfirst nil tukuang_block) 
    623.     (setq  pick_date (entget (car (entsel "\n点选矩形框:"))) GX_list '() GX_list (list (assoc 0 pick_date) (assoc 8 pick_date) (assoc 70 pick_date))) 
    624.     (sssetfirst nil nil)
    625.     (if (assoc 62 pick_date) (setq GX_list (cons  (assoc 62 pick_date) GX_list)))
    626.     (prompt "\n选择要处理对象 / 全选<空格>：")
    627.     (if (not (setq ss_tk (ssget GX_list))) (setq ss_tk (ssget "x"  GX_list))) 
    628.     (setq i -1) 
    629.     (while (setq entname (ssname ss_tk (setq i (1+ i))))
    630.         (setq ss-9 (ssadd) ss-9 (ssadd entname ss-9) pt5b (ss9pt ss-9 5) scale (/ (distance (ss9pt ss-9 1) (ss9pt ss-9 9)) (distance (ss9pt tukuang_block 1) (ss9pt tukuang_block 9) )))        
    631.         (command "COPY" tukuang_block "" "non" pt5a  "non" pt5b  "SCALE" (entlast) "" "non" pt5b  scale)
    632.         (entdel entname)
    633.     );while    
    634.     (command "undo" "e")
    635.     (princ)
    640. )
    643. ;==========================================================================主处理函数
    645. ;;块图框处理主程序
    646. (defun tukuang_BK (H-S 9NB NB NB0 ang / all_lst all_lst_px entname i ss_tk suo_str tk+tz tk+tz+jdpt_lst tkname) 
    647.      (command "undo" "be")
    648.     (if (= YMK_TMP 0)
    649.         (progn (setq tkname (cdr (assoc 2 (entget (setq entname (car (entsel "\n点选图框块:")))))))
    650.              (prompt "\n选择要处理对象 / 全选<空格>：")
    651.              (if (not (setq ss_tk (ssget (list (cons 0 "INSERT") (cons 2 tkname))))) (setq ss_tk (ssget"x"  (list (cons 0 "INSERT") (cons 2 tkname)))));;图框块选集(同名块)
    652.       )
    653.         (setq ss_tk (ssget (list (cons 0 "INSERT"))));图框块选集(异名块)
    654.     );if 
    655.     (sssetfirst nil ss_tk)
    656. (setq i -1 tk+tz+jdpt_lst '() ALL_lst '()) 
    657.     (while (setq entname (ssname ss_tk (setq i (1+ i))))
    659.     (setq     tk+tz (ssget "c" (car (enbox entname)) (cadr (enbox entname))));单张图纸选集
    660.         (setq tk+tz+jdpt_lst    (list tk+tz (car (enbox entname)) entname));;单张图纸选集+左下角点+本图框名 的表
    661.         (setq ALL_lst (cons tk+tz+jdpt_lst ALL_lst));;各自小表合并做大表
    663.     );while
    664. ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■    
    665.     (if (= RB_paixuFS 1) (cond ((= H-S 0) (setq ALL_lst_px (vl-sort ALL_lst '(lambda (a b) (< (car (cadr a)) (car (cadr b)))))));;横排时按对象1点的x值小到大排序，得到新表
    666.                                  ((= H-S 1) (setq ALL_lst_px (vl-sort ALL_lst '(lambda (a b) (< (cadr (cadr a)) (cadr (cadr b)))))));;竖排时按对象1点的y值小到大排序，得到新表
    667.                          );cond
    668.         (setq ALL_lst_px (reverse ALL_lst));选择顺序排列
    669.     );if
    670. ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■    
    671. (if (= cp_xx 0) (DQ_BK ALL_lst_px H-S 9NB) (PL_BK ALL_lst_px H-S NB NB0 ang))    
    672. (command "undo" "e")
    673. (princ)    
    674. )
    676. ;--------------------------------------------------------------------------------
    677. ;;矩形框处理主程序
    678. (defun juxing_WL (H-S 9NB NB NB0 ang / all_lst all_lst_px entname gx_list i pick_date ss_tk suo_str tk+tz tk+tz+jdpt_lst) 
    679.     (command "undo" "be")
    680.     (if (= BGX_TMP 0)
    681.         (progn (setq  pick_date (entget (car (entsel "\n点选矩形框:"))) GX_list '() GX_list (list (assoc 0 pick_date) (assoc 8 pick_date) (assoc 70 pick_date))) (if (assoc 62 pick_date) (setq GX_list (cons  (assoc 62 pick_date) GX_list)))
    682.              (prompt "\n选择要处理对象 / 全选<空格>：")
    683.              (if (not (setq ss_tk (ssget GX_list))) (setq ss_tk (ssget "x"  GX_list)));;矩形框选集(同层、同色)
    684.       )
    685.         (setq ss_tk (ssget (list (cons 0 "LWPOLYLINE") (cons 70 1))));矩形框选集(不共性)
    686.     );if 
    687.     (sssetfirst nil ss_tk)
    689. (setq i -1 tk+tz+jdpt_lst '() ALL_lst '()) 
    690.     (while (setq entname (ssname ss_tk (setq i (1+ i))))
    692.     (setq     tk+tz (ssget "c" (car (enbox entname)) (cadr (enbox entname))));单张图纸选集
    693.         (setq tk+tz+jdpt_lst    (list tk+tz (car (enbox entname)) entname));;单张图纸选集+左下角点+本图框名 的表
    694.         (setq ALL_lst (cons tk+tz+jdpt_lst ALL_lst));;各自小表合并做大表
    696.     );while
    697.     ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    698.     (if (= RB_paixuFS 1) (cond ((= H-S 0) (setq ALL_lst_px (vl-sort ALL_lst '(lambda (a b) (< (car (cadr a)) (car (cadr b)))))));;横排时按对象1点的x值小到大排序，得到新表
    699.                                  ((= H-S 1) (setq ALL_lst_px (vl-sort ALL_lst '(lambda (a b) (< (cadr (cadr a)) (cadr (cadr b)))))));;竖排时按对象1点的y值小到大排序，得到新表
    700.                          );cond
    701.         (setq ALL_lst_px (reverse ALL_lst));选择顺序排列
    702.     );if
    703.     ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    704. (if (= cp_xx 0) (DQ_BK ALL_lst_px H-S 9NB) (PL_BK ALL_lst_px H-S NB NB0 ang))    
    705. (command "undo" "e")
    706. (princ)    
    707. )
    709. ;--------------------------------------------------------------------------------
    710. ;;手工选择处理主程序
    711. (defun select_SG (H-S 9NB NB NB0 ang / all_lst all_lst_px entname i p1 p2 rec ss_tk suo_str tk+tz tk+tz+jdpt_lst)
    712. (command "undo" "be")
    713. (setq ss_tk (ssadd))
    714. (prompt "\n每框选一次为一张图，右键结束选择：")    
    715.     (if (= CKB_TMP 0)
    716.         (while (setq p1 (getpoint "\n点1："))
    717.            (setq p2 (getcorner p1 "\n点2："))
    718.            (command "RECTANG" "non" p1 "non" p2 "CHANGE" (setq rec (entlast)) "" "p" "c" 224 "")
    719.            (setq ss_tk (ssadd rec ss_tk))
    720.         );while
    721.         (while (setq p1 (getpoint "\n点1："))
    722.            (setq p2 (getcorner p1 "\n点2："))
    723.              (setq ss_tk (ssadd (ckb_rec p1 p2) ss_tk))
    724.         )        
    725.     );if
    727. (sssetfirst nil ss_tk)    
    728. (setq i -1 tk+tz+jdpt_lst '() ALL_lst '()) 
    729.     (while (setq entname (ssname ss_tk (setq i (1+ i))))
    731.     (setq     tk+tz (ssget "c" (car (enbox entname)) (cadr (enbox entname))));单张图纸选集
    732.         (setq tk+tz+jdpt_lst    (list tk+tz (car (enbox entname)) entname));;单张图纸选集+左下角点+本图框名 的表
    733.         (setq ALL_lst (cons tk+tz+jdpt_lst ALL_lst));;各自小表合并做大表
    735.     );while
    736. ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    737.     (if (= RB_paixuFS 1) (cond ((= H-S 0) (setq ALL_lst_px (vl-sort ALL_lst '(lambda (a b) (< (car (cadr a)) (car (cadr b)))))));;横排时按对象1点的x值小到大排序，得到新表
    738.                                  ((= H-S 1) (setq ALL_lst_px (vl-sort ALL_lst '(lambda (a b) (< (cadr (cadr a)) (cadr (cadr b)))))));;竖排时按对象1点的y值小到大排序，得到新表
    739.                          );cond
    740.         (setq ALL_lst_px (reverse ALL_lst));选择顺序排列
    741.     );if
    742. ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■    
    743. (if (= cp_xx 0) (DQ_BK ALL_lst_px H-S 9NB) (PL_BK ALL_lst_px H-S NB NB0 ang))        
    744. (command "undo" "e")
    745. (princ)    
    746. )
    748. ;--------------------------------------------------------------------------------
    749. ;;自动识别图框画矩形框-处理主程序
    750. (defun zidongshibie_WL (H-S 9NB NB NB0 ang / all_lst all_lst_px entname gx_list i pick_date ss_tk suo_str tk+tz tk+tz+jdpt_lst) 
    751.     (command "undo" "be")
    753.      (setq ss_tk (maketukuangxian) ss_tk (quchongfu ss_tk));;自动识别图框画框
    754.      (sssetfirst nil ss_tk)    
    756. (setq i -1 tk+tz+jdpt_lst '() ALL_lst '()) 
    757.     (while (setq entname (ssname ss_tk (setq i (1+ i))))
    759.     (setq     tk+tz (ssget "c" (car (enbox entname)) (cadr (enbox entname))));单张图纸选集
    760.         (setq tk+tz+jdpt_lst    (list tk+tz (car (enbox entname)) entname));;单张图纸选集+左下角点+本图框名 的表
    761.         (setq ALL_lst (cons tk+tz+jdpt_lst ALL_lst));;各自小表合并做大表
    763.     );while
    764.     ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    765.     (if (= RB_paixuFS 1) (cond ((= H-S 0) (setq ALL_lst_px (vl-sort ALL_lst '(lambda (a b) (< (car (cadr a)) (car (cadr b)))))));;横排时按对象1点的x值小到大排序，得到新表
    766.                                  ((= H-S 1) (setq ALL_lst_px (vl-sort ALL_lst '(lambda (a b) (< (cadr (cadr a)) (cadr (cadr b)))))));;竖排时按对象1点的y值小到大排序，得到新表
    767.                          );cond
    768.         (setq ALL_lst_px (reverse ALL_lst));选择顺序排列
    769.     );if
    770.     ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    771. (if (= cp_xx 0) (DQ_BK ALL_lst_px H-S 9NB) (PL_BK ALL_lst_px H-S NB NB0 ang))    
    772. (command "undo" "e")
    773.     (if (= LB_TMP 5) (command "ERASE" ss_tk ""))
    774. (princ)    
    775. )
    779. ;; 更新增加阵列代码0309 ◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆
    781. (defun zhenlie_PX (lst / zlpx_list);从左到右从上到下排序
    782.                (setq ZLPX_list (vl-sort (vl-sort lst '(lambda (s1 s2) (> (cadadr s1) (cadadr s2)))) 
    783.                                                     '(lambda (s3 s4) (if(equal (cadadr s3) (cadadr s4) 0.6)(< (caadr s3) (caadr s4))))
    784.                                                          )
    786.                      )
    787.     ZLPX_list
    788. )
    791. (defun zuo>>you_pl (lst pt d flag / ent_pt entname entname1 i);从左到右横向单排子函数
    792.     (command "undo" "be") 
    793.     (setq i -1)
    794.     (repeat (length lst)
    795.           (cond ((= flag 1) (setq entname (car (nth  (setq i (1+ i)) lst)) ent_pt (cadr (nth i lst))))
    796.                 ((= flag 2) (setq entname (car (nth  (setq i (1+ i)) lst)) ent_pt (cadr (nth i lst))))
    797.                     ((= flag 3) (setq entname (car (nth  (setq i (1+ i)) lst)) ent_pt (cadr (nth i lst))) (setq entname1 (caddr (nth i lst))))
    799.           );cond
    800.         (command "move" entname "" "non" ent_pt  "non" pt)
    801.         (cond ((= flag 1) (setq pt (polar pt 0 d))) ;中>中
    802.                 ((= flag 2) (setq pt (polar pt 0 (+ d (- (car (cadr (enbox entname))) (car (car (enbox entname))))) )))    ;边>边(单体)
    803.               ((= flag 3) (setq pt (polar pt 0 (+ d (- (car (cadr (enbox entname1))) (car (car (enbox entname1))))) )))    ;边>边(选集)
    805.         );cond
    806.     )
    807.     (command "undo" "e") 
    808. )
    810. (defun zhenlie_DT (ZL_w ZL_h ZL_nb JJ_x / all_lst all_lst_px entname entname+jdpt_lst enx gx_list i ii iii p0 pick_date ss ssall x_lst);;单体阵列主程序
    812. (command "undo" "be") 
    813. ;==========================================================================
    814. ;单体选择方式处理
    815.     (cond   ((= LB_TMP 1)
    816.                         (if (= SX_TMP 1)            
    817.                             (progn (setq  pick_date (entget (car (entsel "\n点选源对象:"))) GX_list '())
    819.                                 (if (= (cdr (assoc 0 pick_date)) "INSERT")  
    820.                                     (setq  GX_list (list (assoc 0 pick_date) (assoc 2 pick_date)));图块类
    821.                                     (progn (setq  GX_list (list (assoc 0 pick_date) (assoc 8 pick_date))) (if (assoc 62 pick_date) (setq GX_list (cons  (assoc 62 pick_date) GX_list))));其他类
    823.                                 );;收集共性组码
    825.                                 (prompt "\n选择要处理对象 / 全选<空格>：")
    826.                                 (if (not (setq ssall (ssget GX_list))) (setq ssall (ssget "x"  GX_list)));;共性选集(同层、同色)
    828.                                 (sssetfirst nil ssall)
    829.                                 (setq    ss ssall)
    831.                             );progn                            
    832.                             (setq ssall (ssget)  ss ssall)))
    833.     );cond        
    834. ;==========================================================================        
    835. ;(setq ss (ssget))
    836. (setq i -1 entname+jdpt_lst '() ALL_lst '()) 
    837.     (if (= t_tog_zhongdian 0)
    838.     (progn (while (setq entname (ssname ss (setq i (1+ i))))              
    839.         (setq entname+jdpt_lst    (list entname (car (enbox entname))));;单对象名+左下角点 的小表
    840.         (setq ALL_lst (cons entname+jdpt_lst ALL_lst));;各自小表合并做大表              
    841.     );while
    842.     (if (= RB_paixuFS 1) 
    843.     (setq ALL_lst_px (zhenlie_PX ALL_lst));;自动排序后的总表
    844.     (setq ALL_lst_px (reverse ALL_lst));选择顺序排序
    845. );if    
    846.         (setq p0 (getpoint "\n选择阵列起点<退出>: "))
    848.     (setq ii -1 iii 0)     
    849.     (repeat (fix (+ (/ (length ALL_lst_px) (float ZL_nb)) 0.9))
    850.         (setq X_lst '())
    851.         (repeat ZL_nb 
    852.              (if  (setq enx (nth  (setq ii (1+ ii)) ALL_lst_px))
    853.               (setq X_lst  (cons enx X_lst))
    854.              )
    855.       );repeat1
    856.         (setq X_lst (reverse X_lst))
    857.         (cond ((= JJ_x 1) (zuo>>you_pl X_lst p0 ZL_w 1) (setq p0 (polar p0  (* 1.5 pi) ZL_h)));;处理一个小横排再计算下一个小横排基点--中>中 的距离
    858.               ((= JJ_x 2) (zuo>>you_pl X_lst p0 ZL_w 2) (if  (nth  (setq iii  (+ iii ZL_nb)) ALL_lst_px) (setq p0 (polar p0  (* 1.5 pi) (+ ZL_h (- (cadr (cadr (enbox (car (nth  iii ALL_lst_px))))) (cadr (car (enbox (car (nth  iii ALL_lst_px)))))))))));边>边 的距离
    860.         );cond            
    861.     );repeat2
    862.     );progn-左下角基点
    865.     (progn (while (setq entname (ssname ss (setq i (1+ i))))
    867.                 (setq ss-9 (ssadd) ss-9 (ssadd entname ss-9))     
    868.         (setq entname+jdpt_lst    (list entname (ss9pt ss-9 5)));;单对象名+中心点 的小表
    869.         (setq ALL_lst (cons entname+jdpt_lst ALL_lst));;各自小表合并做大表              
    870.     );while
    871.     (if (= RB_paixuFS 1) 
    872.     (setq ALL_lst_px (zhenlie_PX ALL_lst));;自动排序后的总表
    873.     (setq ALL_lst_px (reverse ALL_lst));选择顺序排序
    874. );if    
    875.         (setq p0 (getpoint "\n选择阵列起点<退出>: "))
    877.     (setq ii -1 iii 0)     
    878.     (repeat (fix (+ (/ (length ALL_lst_px) (float ZL_nb)) 0.9))
    879.         (setq X_lst '() H0 (/ (- (cadr (cadr (enbox (car (nth  iii ALL_lst_px))))) (cadr (car (enbox (car (nth  iii ALL_lst_px)))))) 2))
    880.         (repeat ZL_nb 
    881.              (if  (setq enx (nth  (setq ii (1+ ii)) ALL_lst_px))
    882.               (setq X_lst  (cons enx X_lst))
    883.              )
    884.       );repeat1
    885.         (setq X_lst (reverse X_lst))
    886.         (cond ((= JJ_x 1) (zuo>>you_pl X_lst p0 ZL_w 1) (setq p0 (polar p0  (* 1.5 pi) ZL_h)));;处理一个小横排再计算下一个小横排基点--中>中 的距离
    887.               ((= JJ_x 2) (zuo>>you_pl X_lst p0 ZL_w 2) (if  (nth  (setq iii  (+ iii ZL_nb)) ALL_lst_px) (setq p0 (polar p0  (* 1.5 pi) (+ (+ ZL_h (/ (- (cadr (cadr (enbox (car (nth  iii ALL_lst_px))))) (cadr (car (enbox (car (nth  iii ALL_lst_px)))))) 2) )  H0)))));边>边 的距离
    889.         );cond            
    890.     );repeat2
    891.     );progn-中心基点
    894. )
    895. (command "undo" "e")
    896. (princ)        
    897. )
    899. (defun zhenlie_SS (ZL_w ZL_h ZL_nb JJ_x / all_lst all_lst_px entname enx gx_list i ii iii p0 p1 p2 pick_date rec ss ss_tk tk+tz tk+tz+jdpt_lst tkname x_lst);;选集阵列主程序
    900.     (command "undo" "be") 
    901.     ;==========================================================================
    902.     ;分类别选择处理
    903.     (cond   ((= LB_TMP 2)
    904.                         (if (= YMK_TMP 0)
    905.                             (progn (setq tkname (cdr (assoc 2 (entget (setq entname (car (entsel "\n点选图框块:")))))))
    906.                                 (prompt "\n选择要处理对象 / 全选<空格>：")
    907.                                 (if (not (setq ss_tk (ssget (list (cons 0 "INSERT") (cons 2 tkname))))) (setq ss_tk (ssget"x"  (list (cons 0 "INSERT") (cons 2 tkname)))));;图框块选集(同名块)
    908.                             )
    909.                             (setq ss_tk (ssget (list (cons 0 "INSERT"))));图框块选集(异名块)
    910.                         );if 
    911.                         (setq ss ss_tk)
    912.                         (sssetfirst nil ss)                                            
    913.                     );图块类别
    915.         ((= LB_TMP 3)   
    916.             (if (= BGX_TMP 0)
    917.                 (progn (setq  pick_date (entget (car (entsel "\n点选矩形框:"))) GX_list '() GX_list (list (assoc 0 pick_date) (assoc 8 pick_date) (assoc 70 pick_date))) (if (assoc 62 pick_date) (setq GX_list (cons  (assoc 62 pick_date) GX_list)))
    918.                     (prompt "\n选择要处理对象 / 全选<空格>：")
    919.                     (if (not (setq ss_tk (ssget GX_list))) (setq ss_tk (ssget "x"  GX_list)));;矩形框选集(同层、同色)
    920.                 )
    921.                 (setq ss_tk (ssget (list (cons 0 "LWPOLYLINE") (cons 70 1))));矩形框选集(不共性)
    922.             );if 
    923.             (setq ss ss_tk)
    924.             (sssetfirst nil ss)    
    925.         );矩形框类别
    927.         ((= LB_TMP 4)    
    928.             (setq ss_tk (ssadd))
    929.             (prompt "\n每框选一次为一张图，右键结束选择：")    
    930.             (if (= CKB_TMP 0)
    931.                 (while (setq p1 (getpoint "\n点1："))
    932.                     (setq p2 (getcorner p1 "\n点2："))
    933.                     (command "RECTANG" "non" p1 "non" p2 "CHANGE" (setq rec (entlast)) "" "p" "c" 224 "")
    934.                     (setq ss_tk (ssadd rec ss_tk))
    935.                 );while
    936.                 (while (setq p1 (getpoint "\n点1："))
    937.                     (setq p2 (getcorner p1 "\n点2："))
    938.                     (setq ss_tk (ssadd (ckb_rec p1 p2) ss_tk))
    939.                 )        
    940.             );if
    941.             (setq ss ss_tk)
    942.             (sssetfirst nil ss)    
    943.         );手工框选类别    
    945.             ((= LB_TMP 5)   
    946.                 ;(maketukuangxian)
    947.                 (setq ss (maketukuangxian) ss (quchongfu ss))
    948.                 (sssetfirst nil ss)    
    949.           );自动识别类别
    951.     );cond
    952.     ;==========================================================================        
    953.     ;(setq ss (ssget))
    954.     (setq i -1 tk+tz+jdpt_lst '() ALL_lst '()) 
    955.     (while (setq entname (ssname ss (setq i (1+ i))))
    956.         (setq     tk+tz (ssget "c" (car (enbox entname)) (cadr (enbox entname))));图框,图纸内容选集        
    957.         (setq tk+tz+jdpt_lst    (list tk+tz (car (enbox entname)) entname));;图框,图纸内容选集+左下角点+图框图元名 的单张小表
    958.         (setq ALL_lst (cons tk+tz+jdpt_lst ALL_lst));;各自小表合并做大表              
    959.     );while
    961.     (if (= RB_paixuFS 1) 
    962.                          (setq ALL_lst_px (zhenlie_PX ALL_lst));;自动排序后的总表
    963.                          (setq ALL_lst_px (reverse ALL_lst));选择顺序排序
    964.     );if
    965.     (setq p0 (getpoint "\n选择阵列起点<退出>: "))
    966.     (command "-layer" "u" (setq suo_str (layer_suo_str)) "");开锁
    967.     (setq ii -1 iii 0)     
    968.     (repeat (fix (+ (/ (length ALL_lst_px) (float ZL_nb)) 0.999))
    969.         (setq X_lst '())
    970.         (repeat ZL_nb 
    971.             (if  (setq enx (nth  (setq ii (1+ ii)) ALL_lst_px))
    972.                 (setq X_lst  (cons enx X_lst))
    973.             )
    974.       );repeat1
    975.         (setq X_lst (reverse X_lst))
    976.         (cond ((= JJ_x 1) (zuo>>you_pl X_lst p0 ZL_w 1) (setq p0 (polar p0  (* 1.5 pi) ZL_h)));;处理一个小横排再计算下一个小横排基点--中>中 的距离
    977.             ((= JJ_x 3) (zuo>>you_pl X_lst p0 ZL_w 3) (if (nth  (setq iii (+ iii ZL_nb)) ALL_lst_px) (setq p0 (polar p0  (* 1.5 pi) (+ ZL_h (- (cadr (cadr (enbox (caddr (nth  iii ALL_lst_px))))) (cadr (car (enbox (caddr (nth  iii ALL_lst_px)))))))))));边>边 的距离            
    978.         );cond            
    979.     );repeat2    
    980.     (command "undo" "e")
    981.     (command "-layer" "lo"  suo_str  "")
    982.     (if (= LB_TMP 5) (command "ERASE" ss "")) 
    983.     (princ)        
    984. )
    986. (defun zhenlie_FUZHI (ZL_nby ZL_nbx ZL_h ZL_w / lastent pt0 pt1 ss);;复制阵列主程序
    987.     (command "undo" "be")    
    988.     (setq ss (ssget) pt0 (ss9pt ss 5) pt1 (getpoint "\n选取阵列起点/原位<空格>："))
    989.     (if (= RB_zhenliejianju 2) (setq ZL_h (if (>= ZL_h 0) (+ ZL_h (distance (ss9pt ss 1) (ss9pt ss 7))) (- ZL_h (distance (ss9pt ss 1) (ss9pt ss 7)))) ZL_w (if (>= ZL_w 0) (+ ZL_w (distance (ss9pt ss 1) (ss9pt ss 3))) (- ZL_w (distance (ss9pt ss 1) (ss9pt ss 3))))))      
    990.     (if pt1 (command "move" ss "" "non" pt0 "non" pt1))    
    991.     (command "ARRAY" ss "" "r" ZL_nby ZL_nbx ZL_h ZL_w)
    992.     (command "undo" "e")
    993.     (princ)    
    994. )
    997. (defun maketukuangxian (/ bound e entx gx_list i lastent lst pick_date rects ss ss_last);;自动识别图框画矩形框子函数
    999.     (if (= zdSX_TMP 0) (progn (setq  pick_date (entget (car (entsel "\n点选图框最外边框:"))) GX_list '() GX_list (list (assoc 0 pick_date) (assoc 8 pick_date) ))
    1000.          (setq ss (ssget GX_list)));progn
    1001.            (setq ss (ssget '((0 . "LWPOLYLINE,INSERT"))))
    1002.     );if
    1004.   (repeat (setq i (sslength ss))
    1005.     (setq e (ssname ss (setq i (1- i))))
    1006.     (setq lst (cons (ebox e) lst)) ;_提取边界对角点，不生产矩形
    1007.   )
    1008.   (setq lst (vl-sort lst '(lambda (x1 x2) (> (area x1) (area x2))))) ;_按面积大小排序
    1009.   (while lst
    1010.     (setq rects (cons (car lst) rects)) ;_矩形对角点集
    1011.     (setq bound (pt4 (car lst))) ;_矩形边界
    1012.     (setq lst (vl-remove-if '(lambda (x) (and (PtInPoly (car x) bound) (PtInPoly (cadr x) bound))) (cdr lst))) ;_移除大矩形边界内的小矩形
    1013.   )
    1014.     (setq lastent (entlast) ss_last (ssadd))
    1015.   (mapcar '(lambda (x) (command "rectang" (car x) (cadr x))) rects) ;_批量生成矩形
    1016.     (while (setq entx (entnext lastent))
    1017.              (setq ss_last (ssadd entx ss_last) lastent entx)
    1018.     )
    1020.     (command "CHANGE" ss_last "" "p" "c" 224 "")
    1021.     ss_last 
    1022. )
    1024.  (defun ebox (e / pa pb)
    1025.     (and (= 'ename (type e)) (setq e (vlax-ename->vla-object e)))
    1026.     (vlax-invoke-method e 'GetBoundingBox 'pa 'pb)
    1027.     (setq pa (trans (vlax-safearray->list pa) 0 1)
    1028.           pb (trans (vlax-safearray->list pb) 0 1)
    1029.     )
    1030.     (list pa pb)
    1031.   )
    1032.   (defun area (pts) (apply '* (cdr (reverse (apply 'mapcar (cons '- pts)))))) ;_求面积
    1033.   (defun pt4 (pt2)
    1034.     (list (car pt2) (list (caadr pt2) (cadar pt2)) (cadr pt2) (list (caar pt2) (cadadr pt2)))
    1035.   ) ;_对角点生成四角点
    1036.   (defun PtInPoly (pt pts)
    1037.     (equal pi
    1038.            (abs
    1039.              (apply '+ (mapcar '(lambda (x y) (rem (- (angle pt x) (angle pt y)) pi)) (cons (last pts) pts) pts))
    1040.            )
    1041.            1e-6
    1042.     )
    1043.   ) ;_点是否在凸多边形内（角度法）
    1045. (defun quchongfu (ss / ent ent1 i ii pt pt1) 
    1046.     (setq i -1 ss1 (ssadd)) 
    1047.     (while (setq ent (ssname ss (setq i (1+ i))))        
    1048.       (setq DJ_lst (ebox ent))      
    1049.         (setq ii i) 
    1050.         (while (setq ent1 (ssname ss (setq ii (1+ ii))))
    1051.                (setq DJ_lst1 (ebox ent1))
    1052.                (if (equal DJ_lst DJ_lst1  0.01) (setq ss1 (ssadd ent1 ss1)))        
    1053.         );while     
    1054.     );while
    1055.     (command "ERASE" ss1 "")
    1056.     ss
    1057. )
    1061. ;;;=================================================================*
    1062. ;;;生成日期：20200318.175218
    1063. ;;;本文件由程序自动生成。                                           *
    1064. ;;;程序生成完成后需将主代码“*.lsp”文件中的语句中的     *
    1065. ;;; (load_dialog 双引号*.Dcl双引号)改为(load_dialog (make-dcl)) 方可用            *
    1066. ;;;修改后的代码可编辑到主LISP程序后方运行                                                                 *
    1067. ;;;=================================================================*
    1068. ;;;为能让多个有本程序生成的DCL.lsp可以同时使用，生成程序后应将对话框名 (make-dcl)改名   *
    1069. ;;;供需修改两处地方，一处为加载的地方(load_dialog (？？？-make-dcl)) ，另一处为       *
    1070. ;;;对话框主程序名(defun ？？？-make-dcl    ，一定要一致                      *
    1071. ;;;示例：(make-dcl)                                                 *
    1072. (defun make-dcl-pl  (/ lst_str str file f)
    1073.         (setq lst_str '(
    1074. "/*★★★★★ListDCL @ fsxm.mjtd.com★★★★★*/"
    1075. ""
    1076. "rect01:dialog {"
    1077. "    label = \"【对齐/排列/图框排版】ST0318\" ;"
    1078. "    :spacer {}"
    1079. "    :row {"
    1080. "        :boxed_column {"
    1081. "            key = \"k_paixuFS\" ;"
    1082. "            label = \"排序方式\" ;"
    1083. "            :radio_button {"
    1084. "                key = \"k_rb_zidong\" ;"
    1085. "                label = \"自动\" ;"
    1086. "            }"
    1087. "            :radio_button {"
    1088. "                key = \"k_rb_xuanxu\" ;"
    1089. "                label = \"选序\" ;"
    1090. "            }"
    1091. "        }"
    1092. "        :boxed_column {"
    1093. "            label = \"选取方式\" ;"
    1094. "            :row {"
    1095. "                key = \"k_no1\" ;"
    1096. "                :spacer {"
    1097. "                    width = 1.5 ;"
    1098. "                }"
    1099. "                :radio_button {"
    1100. "                    key = \"xlb1\" ;"
    1101. "                    label = \"单体\" ;"
    1102. "                }"
    1103. "                :spacer {}"
    1104. "                :radio_button {"
    1105. "                    key = \"xlb2\" ;"
    1106. "                    label = \"块图框\" ;"
    1107. "                }"
    1108. "                :spacer {}"
    1109. "                :radio_button {"
    1110. "                    key = \"xlb3\" ;"
    1111. "                    label = \"矩形框\" ;"
    1112. "                }"
    1113. "                :spacer {}"
    1114. "                :radio_button {"
    1115. "                    key = \"xlb4\" ;"
    1116. "                    label = \"手工选\" ;"
    1117. "                }"
    1118. "                :spacer {}"
    1119. "                :radio_button {"
    1120. "                    key = \"xlb5\" ;"
    1121. "                    label = \"自动\" ;"
    1122. "                }"
    1123. "            }"
    1124. "            :row {"
    1125. "                key = \"k_no2\" ;"
    1126. "                :spacer {"
    1127. "                    width = 1.5 ;"
    1128. "                }"
    1129. "                :toggle {"
    1130. "                    key = \"toggle_sx\" ;"
    1131. "                    label = \"速选\" ;"
    1132. "                }"
    1133. "                :spacer {}"
    1134. "                :toggle {"
    1135. "                    key = \"toggle_ymk\" ;"
    1136. "                    label = \"异名块\" ;"
    1137. "                }"
    1138. "                :spacer {}"
    1139. "                :toggle {"
    1140. "                    key = \"toggle_bgx\" ;"
    1141. "                    label = \"非共性\" ;"
    1142. "                }"
    1143. "                :spacer {}"
    1144. "                :toggle {"
    1145. "                    key = \"toggle_ckb\" ;"
    1146. "                    label = \"边框比\" ;"
    1147. "                }"
    1148. "                :spacer {}"
    1149. "                :toggle {"
    1150. "                    key = \"toggle_sx2\" ;"
    1151. "                    label = \"速选\" ;"
    1152. "                }"
    1153. "            }"
    1154. "        }"
    1155. "    }"
    1156. "    :image {"
    1157. "        color = 1 ;"
    1158. "        height = 0.12 ;"
    1159. "    }"
    1160. "    :spacer {}"
    1161. "    :row {"
    1162. "        :column {"
    1163. "            :row {"
    1164. "                :row {"
    1165. "                    key = \"row_sxdq\" ;"
    1166. "                    label = \"双向对齐\" ;"
    1167. "                    :column {"
    1168. "                        :button {"
    1169. "                            key = \"dtpl7\" ;"
    1170. "                            label = \"╔\" ;"
    1171. "                        }"
    1172. "                        :button {"
    1173. "                            key = \"dtpl8\" ;"
    1174. "                            label = \"╠\" ;"
    1175. "                        }"
    1176. "                        :button {"
    1177. "                            key = \"dtpl9\" ;"
    1178. "                            label = \"╚\" ;"
    1179. "                        }"
    1180. "                    }"
    1181. "                    :column {"
    1182. "                        :button {"
    1183. "                            key = \"dtpl10\" ;"
    1184. "                            label = \"╦\" ;"
    1185. "                        }"
    1186. "                        :button {"
    1187. "                            key = \"dtpl11\" ;"
    1188. "                            label = \"╬\" ;"
    1189. "                        }"
    1190. "                        :button {"
    1191. "                            key = \"dtpl12\" ;"
    1192. "                            label = \"╩\" ;"
    1193. "                        }"
    1194. "                    }"
    1195. "                    :column {"
    1196. "                        :button {"
    1197. "                            key = \"dtpl13\" ;"
    1198. "                            label = \"╗\" ;"
    1199. "                        }"
    1200. "                        :button {"
    1201. "                            key = \"dtpl14\" ;"
    1202. "                            label = \"╣\" ;"
    1203. "                        }"
    1204. "                        :button {"
    1205. "                            key = \"dtpl15\" ;"
    1206. "                            label = \"╝\" ;"
    1207. "                        }"
    1208. "                    }"
    1209. "                }"
    1210. "                :column {"
    1211. "                    key = \"k_shuipingduiqi\" ;"
    1212. "                    label = \"水平对齐\" ;"
    1213. "                    :button {"
    1214. "                        key = \"dtpl1\" ;"
    1215. "                        label = \"┳\" ;"
    1216. "                    }"
    1217. "                    :button {"
    1218. "                        key = \"dtpl2\" ;"
    1219. "                        label = \"━\" ;"
    1220. "                    }"
    1221. "                    :button {"
    1222. "                        key = \"dtpl3\" ;"
    1223. "                        label = \"┻\" ;"
    1224. "                    }"
    1225. "                }"
    1226. "                :column {"
    1227. "                    key = \"k_chuizhiduiqi\" ;"
    1228. "                    label = \"垂直对齐\" ;"
    1229. "                    :button {"
    1230. "                        key = \"dtpl4\" ;"
    1231. "                        label = \"┣\" ;"
    1232. "                    }"
    1233. "                    :button {"
    1234. "                        key = \"dtpl5\" ;"
    1235. "                        label = \"┃\" ;"
    1236. "                    }"
    1237. "                    :button {"
    1238. "                        key = \"dtpl6\" ;"
    1239. "                        label = \"┫\" ;"
    1240. "                    }"
    1241. "                }"
    1242. "            }"
    1243. "            :spacer {"
    1244. "                height = 0.5 ;"
    1245. "            }"
    1246. "            :row {"
    1247. "                height = 1 ;"
    1248. "                key = \"k_dengju,dianxuan\" ;"
    1249. "                :column {"
    1250. "                    :toggle {"
    1251. "                        alignment = centered ;"
    1252. "                        key = \"cp_x\" ;"
    1253. "                        label = \"等距重排\" ;"
    1254. "                    }"
    1255. "                }"
    1256. "                :column {"
    1257. "                    :edit_box {"
    1258. "                        alignment = top ;"
    1259. "                        key = \"cp_d\" ;"
    1260. "                        label = \"间距:\" ;"
    1261. "                    }"
    1262. "                }"
    1263. "                :column {"
    1264. "                    :button {"
    1265. "                        alignment = top ;"
    1266. "                        key = \"dxjj\" ;"
    1267. "                        label = \"点选定距\" ;"
    1268. "                    }"
    1269. "                }"
    1270. "                :spacer {}"
    1271. "            }"
    1272. "        }"
    1273. "        :column {"
    1274. "            :row {"
    1275. "                label = \"阵列\" ;"
    1276. "                :column {"
    1277. "                    :row {"
    1278. "                        :text {"
    1279. "                            label = \"方式:\" ;"
    1280. "                        }"
    1281. "                        :radio_button {"
    1282. "                            key = \"k_rb_chongpaizhenlie\" ;"
    1283. "                            label = \"重排阵列\" ;"
    1284. "                        }"
    1285. "                        :radio_button {"
    1286. "                            key = \"k_rb_fuzhizhenlie\" ;"
    1287. "                            label = \"复制阵列\" ;"
    1288. "                        }"
    1289. "                    }"
    1290. "                    :row {"
    1291. "                        :edit_box {"
    1292. "                            key = \"k_hengju\" ;"
    1293. "                            label = \"横距:\" ;"
    1294. "                        }"
    1295. "                        :edit_box {"
    1296. "                            key = \"k_hengshu\" ;"
    1297. "                            label = \"个数:\" ;"
    1298. "                        }"
    1299. "                    }"
    1300. "                    :row {"
    1301. "                        :edit_box {"
    1302. "                            key = \"k_shuju\" ;"
    1303. "                            label = \"竖距:\" ;"
    1304. "                        }"
    1305. "                        :edit_box {"
    1306. "                            key = \"k_shushu\" ;"
    1307. "                            label = \"个数:\" ;"
    1308. "                        }"
    1309. "                    }"
    1310. "                    :spacer {}"
    1311. "                    :row {"
    1312. "                        :text {"
    1313. "                            label = \"算法:\" ;"
    1314. "                        }"
    1315. "                        :radio_button {"
    1316. "                            key = \"k_rb_zhongzhong\" ;"
    1317. "                            label = \"点<->点\" ;"
    1318. "                        }"
    1319. "                        :spacer {}"
    1320. "                        :radio_button {"
    1321. "                            key = \"k_rb_bianbian\" ;"
    1322. "                            label = \"边<->边\" ;"
    1323. "                        }"
    1324. "                        :spacer {}"
    1325. "                    }"
    1326. "                    :row {"
    1327. "                        :text {"
    1328. "                            label = \"基点:\" ;"
    1329. "                        }"
    1330. "                        :toggle {"
    1331. "                            key = \"k_tog_zhongdian\" ;"
    1332. "                            label = \"中点\" ;"
    1333. "                        }"
    1334. "                        :button {"
    1335. "                            key = \"k_bt_dianxuan\" ;"
    1336. "                            label = \"选距\" ;"
    1337. "                        }"
    1338. "                        :button {"
    1339. "                            key = \"k_zlqueding\" ;"
    1340. "                            label = \"确定\" ;"
    1341. "                        }"
    1342. "                    }"
    1343. "                }"
    1344. "            }"
    1345. "        }"
    1346. "    }"
    1347. "    :spacer {}"
    1348. "    :column {"
    1349. "        label = \"插图框\" ;"
    1350. "        :row {"
    1351. "            :spacer {}"
    1352. "            :radio_button {"
    1353. "                key = \"k_moren\" ;"
    1354. "                label = \"默认图块\" ;"
    1355. "            }"
    1356. "            :radio_button {"
    1357. "                key = \"k_tuzhong\" ;"
    1358. "                label = \"图中选块\" ;"
    1359. "            }"
    1360. "            :radio_button {"
    1361. "                key = \"k_chawenjian\" ;"
    1362. "                label = \"插块文件 >>>\" ;"
    1363. "            }"
    1364. "            :button {"
    1365. "                key = \"k_liulan\" ;"
    1366. "                label = \"浏览\" ;"
    1367. "            }"
    1368. "            :button {"
    1369. "                alignment = right ;"
    1370. "                key = \"k_ctk\" ;"
    1371. "                label = \"插图框\" ;"
    1372. "            }"
    1373. "        }"
    1374. "        :text {"
    1375. "            alignment = left ;"
    1376. "            key = \"k_lujing\" ;"
    1377. "        }"
    1378. "        :spacer {}"
    1379. "    }"
    1380. "    :row {"
    1381. "        :text {"
    1382. "            value = \"注:1,图框不能交叉.  2, 插入的图框文件尺寸:594x420mm.\" ;"
    1383. "        }"
    1384. "        cancel_button;"
    1385. "    }"
    1386. "}"
    1387.             )
    1388.     )
    1389.     (setq file (vl-filename-mktemp "DclTemp.dcl"))
    1390.     (setq f (open file "w"))
    1391.     (foreach str lst_str
    1392.     (princ "\n" f)
    1393.     (princ str f)
    1394.     )
    1395.     (close f)
    1396.     ;;返回
    1397.     file
    1398. )
    1399. ;;;=================================================================*
    1400. (princ)