【已解决】批量写块WBLOCK，感谢阿甘大侠出手
本帖最后由 tigcat 于 2021-8-2 20:47 编辑背景：目前建筑图较多平面，为了灵活调用，其他专业需要将每个平面写块出来，命名为建筑-平面-1F、建筑-平面-2F……，如此往复劳动，大费周章，能不能用程序实现这么一个功能：每个平面套个图框（多段线，比如图层是TITLE），然后平面里面放置一个定位基点块（可以是个十字形或者什么，块名bbase_pt），放置一个图名文字（特殊图层，例如block_name），然后批量选择图层名TITLE的多段线，以cp方式把这个多段线内的图元写到一个指定的目录，图块名为，建筑-平面-block_name,基点为bbase_pt的基点。
如果能实现就好。哪位大侠能帮忙实现下呢？相信很多工程人都有作用。
本帖最后由 print1985 于 2021-7-30 00:17 编辑
;批量写块-导出平面图
(defun c:xk ( / en-ss i jd-block jd-en jd-pt jd-ss pm-ss pst tk-layer tk-ss tm-en tm-layer tm-ss tm-text)
(setq tk-layer "PUB_TITLE") ;定义图框图层
(setq tm-layer "PUB_TITLE_图名") ;定义图名图层
(setq jd-block "平面基点图块") ;定义基点块名
(setq i 0)
(princ "\n选择图框")
(if (setq tk-ss (ssget (list '(0 . "LWPOLYLINE") (cons 8 tk-layer) '(43 . 0))));选择线宽为0图框
(progn
(repeat (sslength tk-ss)
(setq en-ss (ssname tk-ss i)
pst (get-pl-ptlst en-ss) ;图框PL线点表
pm-ss (ssget "cp" pst) ;选择平面
tm-ss (ssget "cp" pst (list '(0 . "TEXT,MTEXT") (cons 8 tm-layer))) ;选择图名
tm-en (ssname tm-ss 0) ;图名图元名
tm-text (cdr (assoc 1 (entget tm-en))) ;图名文字
jd-ss (ssget "cp" pst (list '(0 . "INSERT") (cons 2 jd-block))) ;选择图块
jd-en (ssname jd-ss 0) ;图块图元名
jd-pt (cdr (assoc 10 (entget jd-en))) ;图块基点坐标
)
(vl-cmdf "WBLOCK" tm-text "" jd-pt pm-ss "");写块-导出平面
(vl-cmdf "oops");恢复删除的内容
(setq i (1+ i))
)
)
)
(princ)
)
;取得多义线顶点表 来自明经
(defun get-pl-ptlst (plent / ptlst)
(setq ptlst (vl-remove-if '(lambda (x) (/= 10 (car x)))(entget plent)))
(mapcar 'cdr ptlst)
)
简单弄了下，其它功能你自己加吧
对了，写出的块不要包含定位基点块和定位图名文字。 这个其实是管理问题，如果其他所有专业都需要切分图纸，那就该让建筑专业改变习惯，分图绘制 大家都很忙，都是为了生活奔波，不好要求别人改变 编程的流程你都说了，难度好像不大，只是细节有点多，你应该可以自己做出来的，给你加油 print1985 发表于 2021-7-29 23:16
编程的流程你都说了，难度好像不大，只是细节有点多，你应该可以自己做出来的，给你加油
哈哈，阿甘大侠来了，对我有点难度，我是初级阶段的选手，对文件读写的操作不熟悉。 感觉差不太多，用个wblock命令，再找下写文件函数就行了 print1985 发表于 2021-7-30 00:14
;批量写块-导出平面图
(defun c:xk ( / en-ss i jd-block jd-en jd-pt jd-ss pm-ss pst tk-layer tk-ss tm ...
感谢阿甘大侠，深夜帮忙写代码，剩下的没问题了。{:1_1:} 你好可以发个你描述的图纸吗
页:
[1]
2