求助大神帮忙修改成闭合多段线也能排版，（下面代码只能排矩形框）
本帖最后由 296715530 于 2019-12-9 17:58 编辑(defun c:pb (/ 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
(setq ent (entget (ssname ss 0)))
(princ (strcat "\n选定的外图框图层名是：" (cdr (assoc 8 ent))))
(princ ",请选择要排版的所有(图框)对象：")
(if (setq ss (ssget (list '(0 . "LWPOLYLINE") '(90 . 4) (assoc 8 ent))))
(progn
(setvar "nomutt" 0)
(setq ss (juxingguolv ss))
(or pbjj (setq pbjj 100.0))
(or paiban (setq paiban "X") )
(if (setq pbjj1 (getdist (strcat "\n请输入图纸排版间距或直接量取：<" (rtos pbjj 2 2) ">:")))
(setq pbjj pbjj1))
(if (member (setq panban1 (strcase (getstring (strcat "\n请选择排版方向[横向(X)/纵向(Y)]：<"
paiban ">")))) '("X" "Y"))
(setq paiban panban1))
(if (setq ptn (getpoint "\n指定一点做为排版的新起点位置(注意尽量远离选择的图形区域)："))
(progn
(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))
(command "move" (ssget "_c" pmin pmax) "" pmin ptn)
(cond
((= paiban "X") (setq ptn (list (+ (car ptn) (- (car pmax) (car pmin)) pbjj) (cadr
ptn))))
((= paiban "Y") (setq ptn (list (car ptn) (+ (cadr ptn) (- (cadr pmax) (cadr pmin))
pbjj)))))))))))
)
(setvar "nomutt" 0)
(command "UNDO" "e")
(setvar "cmdecho" 1)
(setvar "osmode" os1)
(princ)
)
你这个排版要超出你的母版 矩形框可以排，非矩形框(多段线框)和框里面的图元会留在原地不动， 不规则图形用CAD插件不是很好，其实有很多专业的排板套料软件可以选择啊 自动排版可没那么容易实现哟 love1030312 发表于 2019-12-11 08:27
自动排版可没那么容易实现哟
我用ngc的工具箱，可以实现自动排窗线 此贴问题终结，感谢热心人 支持支持😊，，回去用用 (defun c:bn (/ ent i j lst1 lst2 maxpoint minpoint namM namM1 namM2 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 nam name1 name2 pmax pmin pt1x pt1y pt2x
pt2y pt3x pt3y pt4x pt4y ) ; 过滤掉矩形选择集内的矩形子函数 nam
(setq lst1 '())
(repeat (setq i (sslength ss))
(setq nam (ssname ss (setq i (1- i))))
(vla-getboundingbox (vlax-ename->vla-object nam) 'minpoint 'maxpoint)
(setq pmax (vlax-safearray->list maxpoint)pmin (vlax-safearray->list minpoint))
(setq lst1 (cons (list pmin pmax nam) lst1))
)
(setq lst2 lst1)
(repeat (setq i (length lst1))
(setq nam (nth (setq i (1- i)) lst1))
(setq pt1x (car (car nam))pt1y (cadr (car nam))pt2x (car (cadr nam))
pt2y (cadr (cadr nam))name1 (caddr nam) )
(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 "请选择要排版的所有(图框)对象：");取消了选外框
(setq ss (ssget (list '(0 . "LWPOLYLINE")))) ;'(90 . 4)(assoc 8 ent)
(progn
(setvar "nomutt" 0)
(setq ss (juxingguolv ss))
(or pbjj (setq pbjj 100.0))
(or paiban (setq paiban "X") )
(if (setq pbjj1 (getdist (strcat "\n请输入图纸排版间距或直接量取：<" (rtos pbjj 2 2) ">:")))
(setq pbjj pbjj1))
(if (member (setq panban1 (strcase (getstring (strcat "\n请选择排版方向[横向(X)/纵向(Y)]：<"paiban ">")))) '("X" "Y"))
(setq paiban panban1))
(if (setq ptn (getpoint "\n指定一点做为排版的新起点位置(注意尽量远离选择的图形区域)："))
(progn
(repeat (setq i (sslength ss))
(setq namm (ssname ss (setq i (1- i))))
(vla-getboundingbox (vlax-ename->vla-object namm) 'minpoint 'maxpoint)
(setq pmax (vlax-safearray->list maxpoint) pmin (vlax-safearray->list minpoint))
(command "move" (ssget "_c" pmin pmax) "" pmin ptn)
(cond
((= paiban "X") (setq ptn (list (+ (car ptn) (- (car pmax) (car pmin)) pbjj) (cadr
ptn))))
((= paiban "Y") (setq ptn (list (car ptn) (+ (cadr ptn) (- (cadr pmax) (cadr pmin))
pbjj)))))))) ;)))
)
(setvar "nomutt" 0)
(command "UNDO" "e")
(setvar "cmdecho" 1)
(setvar "osmode" os1)
(princ)
)
页:
[1]