sunny_8848 发表于 2018-11-28 10:15:11

图框对齐代码修改

本帖最后由 sunny_8848 于 2018-11-29 08:44 编辑

下面是论坛下载的，用于图框对齐，能否帮忙修改成图框下对齐方式（现在是上对齐），图框及图形排列顺序按选择顺序（现在和选择顺序相反）
(defun c:tkpb (/ ent i j lst1 lst2 maxpoint minpoint name name1 name2 os1 panban1 pbjj1 pmax pmin pt1x pt1y pt2x pt2y pt3x
               pt3y pt4x pt4y ptn ss )
(defun juxingguolv (ss / ent i j lst1 lst2 maxpoint minpoint name name1 name2 pmax pmin pt1x pt1y pt2x pt2y pt3x pt3y
                         pt4x pt4y )                     ; 过滤掉矩形选择集内的矩形子函数
    (setq lst1 '())
    (repeat (setq i (sslength ss))
      (setq name (ssname ss (setq i (1- i))))
      (vla-getboundingbox (vlax-ename->vla-object name) 'minpoint 'maxpoint)
      (setq pmax (vlax-safearray->list maxpoint)pmin (vlax-safearray->list minpoint))
      (setq lst1 (cons (list pmin pmax name) lst1))
    )
    (setq lst2 lst1)
    (repeat (setq i (length lst1))
      (setq name (nth (setq i (1- i)) lst1))
      (setq pt1x (car (car name))pt1y (cadr (car name))pt2x (car (cadr name))
            pt2y (cadr (cadr name))name1 (caddr name) )
      (repeat (setq j (length lst2))
      (setq ent (nth (setq j (1- j))lst2 ))
      (setq pt3x (car (car ent))pt3y (cadr (car ent)) pt4x (car (cadr ent))
            pt4y (cadr (cadr ent))   name2 (caddr ent))
      (if (and (> pt3x pt1x) (> pt3y pt1y)(< pt4x pt2x) (< pt4y pt2y))
          (if (ssmemb name2 ss)(setq ss (ssdel name2 ss))))
      (if (and (< pt3x pt1x) (< pt3y pt1y) (> pt4x pt2x)(> pt4y pt2y))
          (if (ssmemb name1 ss) (setq ss (ssdel name1 ss))))))
    ss
)
(vl-load-com)
(command "UNDO" "be")
(setq os1 (getvar "osmode"))
(setvar "osmode" 0)
(setvar "CMDECHO" 0)
(setvar "nomutt" 1)
(princ "\n选择一个外图框对象以指定外框图层：")
(if (setq ss (ssget ":S" (list '(0 . "LWPOLYLINE") '(90 . 4))))
    (progn

(setvar "nomutt" 0)
(command "UNDO" "e")
(setvar "cmdecho" 1)
(setvar "osmode" os1)
(princ)
)

bai2000 发表于 2018-11-30 09:36:35

能不能改成选属性块的图框来排列啊，很多图框都是属性块的

xyp1964 发表于 2018-11-29 23:43:02

;; tt(图框对齐排版) 非源码
(defun c:tt ()
(xyp-Start)
(if (and (setq s1 (car (entsel "\n选择一般外框图层: ")))
           (xyp-etype s1 "*polyline")
           (setq la (xyp-DXF 8 s1))
           (setq ss (ssget (list '(0 . "*polyLINE") '(90 . 4) '(70 . 1) (cons 8 la))))
           (setq p0 (getpoint "\n基点<退出>: "))
      )
    (setq lst (vl-sort (xyp-Ss2List ss)
                     '(lambda (a b) (> (xyp-EnameWide a) (xyp-EnameWide b)))
              )
          aa(mapcar '(lambda (x)
                       (setq p1 (xyp-9pt2d x 1)
                             p9 (xyp-9pt2d x 9)
                       )
                       (xyp-move (ssget "c" p1 p9) p1 p0)
                       (setq p0 (xyp-Pt2X (xyp-9pt2d x 3) 100))
                     )
                      lst
              )
    )
)
(xyp-End)
)

sunny_8848 发表于 2018-11-30 11:12:16

本帖最后由 sunny_8848 于 2018-11-30 11:15 编辑

xyp1964 发表于 2018-11-29 23:43

多谢帮忙。运行后提示：; 错误: no function definition: XYP-START错误: no function definition: XYP-ETYPE能否帮忙写全代码，确实不懂这个lsp

sunny_8848 发表于 2018-11-28 10:25:12

本帖最后由 sunny_8848 于 2018-11-29 10:06 编辑

sunny_8848 发表于 2018-11-28 11:10:29

是否要送明经币？多少个合适呢

依然小小鸟 发表于 2018-11-28 12:02:40

sunny_8848 发表于 2018-11-28 11:10
是否要送明经币？多少个合适呢

这不是我发的帖子吗我找到一个更完美的图框对齐了 完爆这个

依然小小鸟 发表于 2018-11-28 12:02:58

不过还是希望有大神把这个代码改下

sunny_8848 发表于 2018-11-28 12:55:54

本帖最后由 sunny_8848 于 2018-11-28 12:58 编辑

依然小小鸟 发表于 2018-11-28 12:02
这不是我发的帖子吗我找到一个更完美的图框对齐了 完爆这个
是的。能共享下吗。邮箱：791504815@qq.com

ssyfeng 发表于 2018-11-29 09:23:28

试试行不行：


sunny_8848 发表于 2018-11-29 09:33:35

本帖最后由 sunny_8848 于 2018-11-29 10:07 编辑

ssyfeng 发表于 2018-11-29 09:23
试试行不行：
谢谢帮忙。排版顺序和图框选择顺序相反了；想改成下对齐的。上面的附件已经改为下对齐，可是就是不会改成图框排列顺序和选择顺序一致

yxl88168 发表于 2018-11-29 17:26:43

ssyfeng 发表于 2018-11-29 09:23
试试行不行：

能不能改成选属性块的图框来排列啊，很多图框都是属性块的
页: [1] 2
查看完整版本: 图框对齐代码修改