导入贴图分幅

woodman78 · 发表于 2022-7-6 06:41:56

我收到我们绘图室的人的请求。我们插入地图块以形成背景映射。这意味着在图纸上搜索正确的数字，并在目录中搜索以找到正确的瓷砖并插入它们。

我正在考虑创建一个具有“缩略图”的图形，它只是一个带有地图分幅编号的矩形，这样当用户选择一些“缩略图”时，就会打开一个新图形，并插入正确的分幅。

我想知道以前是否有人做过这样或类似的事情？

谢谢
布莱恩。

BIGAL · 发表于 2022-7-6 06:47:53

就像20年前一样，只需创建一个带有文本标签的网格，一个非常简单的隐藏地图，这样你就知道你在哪里，选择文本，然后运行插入正确的图像，使用lisp中的STRCAT将目录添加到标签名称，我们有多层瓷砖，所以使用自定义侧菜单选择瓷砖图像、块、nottes等的样式

非真实代码

copy


(setq gridder (Entsel "pick grid lable))
do normal pull out gridtext plus work out the insert pt in real worl co0ords based on text insertion point -xinc -yinc
(setq gridname (strcat "c:\mydir\images" gridtext))
(command "insertimage" gridname pt 1 1 )

您可以执行类似于自动打开网格dwg拾取网格关闭它并将图像插入原始dwg的操作，而无需多个用户输入。

woodman78 · 发表于 2022-7-6 06:50:14

谢谢Bigal，

你给了我一些想法。让我进一步解释一下设置。我们的地图分为1:5000、1:2500、1:1000。它们位于映射文件夹的3个子目录中。我没有权限，也不希望以任何方式更改此文件夹结构。我想把瓷砖从里面拿出来。每个文件夹中的文件名如下：（见下图）。
1： 5000地图块编号，无添加-（示例）5411。图纸
1： 2500地图块编号加上A、B、C或D-（示例）5411-A.dwg
1： 1000地图块数加上1到25-（示例）5411-18。图纸

（编辑：每个地图分幅可以有一个1:5000，以及几个1:2500和1:1000来完成整个分幅，分幅不同）

这是我现在掌握的代码：

copy

(defun c:Getmaptile  (/ bn chk pp bnloc)
(setq bn "" chk nil); set block name nil
(while (= chk nil)
(setq chk (entsel "\nPick a Block: "))
)
(setq pp (cadr chk))
(setq chk (entget (car chk)))
(setq bn (cdr (assoc 2 chk))); get block name
(setq bnloc (strcat "M:\\os\\Maps\\AutoCAD\\2500\" bn "-D"))
(command "_.-insert" bnloc "0,0,0" "1" "1" "0")
(princ)
)

此代码的工作原理是，它将按照代码中的规定插入平铺，并将其插入到当前图形中。我需要获取代码来搜索“M:\\os\\Maps\\AutoCAD\”目录中以我在图形中选择的块“缩略图”中的四位数字开头的所有块。但我需要把它们放在一张新的画里。。。。。。

有人能帮我从这里开始怎么走吗？
我试图创建一个基于模板的新绘图，但代码创建了绘图，但随后恢复到原始绘图。。。

谢谢

woodman78 · 发表于 2022-7-6 06:53:37

最后一小时的进展。我找到了这个链接：
http://www.cadtutor.net/forum/showthread.php?57051-使用Lisp搜索并插入多个图形作为块。

所以我把它合并到代码中，除了新的绘图之外，它运行得很好。我需要启动一个新的绘图并将块插入其中。。。。
也可以选择多个块并插入所选块的所有块。。。。

不管怎样，这就是我所拥有的。。

copy

(defun c:Getmaptile  (/ bn chk pp bnloc)
(setq bn "" chk nil); set block name nil
(while (= chk nil)
(setq chk (entsel "\nPick a Block: "))
)
(setq pp (cadr chk))
(setq chk (entget (car chk)))
(setq bn (cdr (assoc 2 chk))); get block name
;(setq bnloc (strcat "M:\\os\\Maps\\AutoCAD\\2500\" bn))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\5000\" bn "*.dwg")))
(foreach Dwg Drawings
   (command "_.insert" Dwg "0,0,0" "1" "1" "0") 
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\2500\" bn "*.dwg")))
(foreach Dwg Drawings
   (command "_.insert" Dwg "0,0,0" "1" "1" "0")
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\1000\" bn "*.dwg")))
(foreach Dwg Drawings
   (command "_.insert" Dwg "0,0,0" "1" "1" "0") 
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(command "_.-insert" bnloc "0,0,0" "1" "1" "0")
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function to list files from a wildcard match
(defun matchfiles (path / item dir match lst fil files)
 (setq path (strsplit "," path))
 (foreach item path
   (setq dir   (strcat (vl-string-right-trim "\" (vl-filename-directory item)) "\")
         match (substr item (1+ (strlen dir)))
         lst   (vl-directory-files dir match 1)
   )
   (foreach fil lst
     (setq files (cons (strcat dir fil) files))
   )
 )
 (reverse files)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function to split a string on a specified character
(defun strsplit (c str / lst p n)
 (setq n 0)
 (while (setq p (vl-string-search c str n))
   (setq lst (cons (substr str (1+ n) (- p n)) lst))
   (setq n (1+ p))
 )
 (if (< n (strlen str))
   (setq lst (cons (substr str (1+ n)) lst))
 )
 (reverse lst)
)

BIGAL · 发表于 2022-7-6 06:57:50

你需要沿着脚本路径走，这样你可以打开一个新的dwg并继续，我会使用你删除的“插入”并更改为写入文件插入新的dwg等

使用ssget而不是entsel，然后您可以选择一个或多个网格标签，再进行一次包含所有代码的foreach。为什么不是网格标签的文本？与块相同的方法

最后一行代码是脚本平铺

copy


(setq fout (open "C:\acadtemp\tiles.scr" "w"))
(setvar "filedia" 0)
(write-line "new  " fout) ; note 2 spaces check for using default dwt etc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\5000\" bn "*.dwg")))
(foreach Dwg Drawings
   ;(command "_.insert" Dwg "0,0,0" "1" "1" "0") 
(setq dwgtile (strcat "_.insert" dwg "0,0,0" "1" "1" "0"))
(Write-line dwgtile fout)
 )
(close fout)
; last line
(command "script" "C:\acadtemp\tiles")

woodman78 · 发表于 2022-7-6 06:58:24

比加尔，

谢谢你的帮助。我今天才回到办公室。复活节我们在爱尔兰度过了一个漫长的周末假期。
我正试图找出如何将你给我的东西整合到代码中。我知道“插入”被替换了。但是最后的剧本呢？我需要在那个位置存储什么脚本？

还有，我该如何按照你的建议使用“网格标签”？
我以前从未使用过或听说过它们，这就是我选择使用积木的原因。。

谢谢

woodman78 · 发表于 2022-7-6 07:01:36

这就是我的Bigal，但我在加载时遇到了一个错误：

copy

(defun c:Getmaptile  (/ bn chk pp bnloc)
(setq bn "" chk nil); set block name nil
(while (= chk nil)
(setq chk (ssget "\nPick a Block: "))
)
(setq pp (cadr chk))
(setq chk (entget (car chk)))
(setq bn (cdr (assoc 2 chk))); get block name
[color="red"](setq fout (open "C:\acadtemp\tiles.scr "w"))
(setvar "filedia" 0)
(write-line "new  " fout) ; note 2 spaces check for using default dwt etc[/color]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\5000\" bn "*.dwg")))
(foreach Dwg Drawings
[color="red"]    ;(command "_.insert" Dwg "0,0,0" "1" "1" "0") 
(setq dwgtile (strcat "_.insert" dwg "0,0,0" "1" "1" "0"))
(Write-line dwgtile fout)
 
(close fout)
 )[/color]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\2500\" bn "*.dwg")))
(foreach Dwg Drawings
[color="red"]    ;(command "_.insert" Dwg "0,0,0" "1" "1" "0")
(setq dwgtile (strcat "_.insert" dwg "0,0,0" "1" "1" "0"))
(Write-line dwgtile fout)
 
(close fout)
 )[/color]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\1000\" bn "*.dwg")))
(foreach Dwg Drawings
[color="red"]    ;(command "_.insert" Dwg "0,0,0" "1" "1" "0") 
(setq dwgtile (strcat "_.insert" dwg "0,0,0" "1" "1" "0"))
(Write-line dwgtile fout)
 
(close fout)
 )[/color]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
)
[color="red"](command "script" "C:\acadtemp\tiles")[/color]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function to list files from a wildcard match
(defun matchfiles (path / item dir match lst fil files)
 (setq path (strsplit "," path))
 (foreach item path
   (setq dir   (strcat (vl-string-right-trim "\" (vl-filename-directory item)) "\")
         match (substr item (1+ (strlen dir)))
         lst   (vl-directory-files dir match 1)
   )
   (foreach fil lst
     (setq files (cons (strcat dir fil) files))
   )
 )
 (reverse files)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function to split a string on a specified character
(defun strsplit (c str / lst p n)
 (setq n 0)
 (while (setq p (vl-string-search c str n))
   (setq lst (cons (substr str (1+ n) (- p n)) lst))
   (setq n (1+ p))
 )
 (if (< n (strlen str))
   (setq lst (cons (substr str (1+ n)) lst))
 )
 (reverse lst)
)

你能看一下吗？
谢谢

BIGAL · 发表于 2022-7-6 07:05:28

我犯的错误
“C:\acadtemp\tiles.scr”w“缺失”
“C:\acadtemp\tiles.scr”“w”
固定在上面

woodman78 · 发表于 2022-7-6 07:09:59

比加尔，

我对代码进行了更改以获得以下内容：

copy

(defun c:Getmaptile  (/ bn chk pp bnloc)
(setq bn "" chk nil); set block name nil
(while (= chk nil)
(setq chk (ssget "\nPick a Block: "))
)
(setq pp (cadr chk))
(setq chk (entget (car chk)))
(setq bn (cdr (assoc 2 chk))); get block name
(setq fout (open "C:\acadtemp\tiles.scr" "w"))
(setvar "filedia" 0)
(write-line "new  " fout) ; note 2 spaces check for using default dwt etc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\5000\" bn "*.dwg")))
(foreach Dwg Drawings
   ;(command "_.insert" Dwg "0,0,0" "1" "1" "0") 
(setq dwgtile (strcat "_.insert" dwg "0,0,0" "1" "1" "0"))
(Write-line dwgtile fout)
 
(close fout)
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\2500\" bn "*.dwg")))
(foreach Dwg Drawings
   ;(command "_.insert" Dwg "0,0,0" "1" "1" "0")
(setq dwgtile (strcat "_.insert" dwg "0,0,0" "1" "1" "0"))
(Write-line dwgtile fout)
 
(close fout)
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq Drawings (matchfiles (strcat "M:\\os\\Maps\\AutoCAD\\1000\" bn "*.dwg")))
(foreach Dwg Drawings
   ;(command "_.insert" Dwg "0,0,0" "1" "1" "0") 
(setq dwgtile (strcat "_.insert" dwg "0,0,0" "1" "1" "0"))
(Write-line dwgtile fout)
 
(close fout)
 )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
)
(command "script" "C:\acadtemp\tiles")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function to list files from a wildcard match
(defun matchfiles (path / item dir match lst fil files)
 (setq path (strsplit "," path))
 (foreach item path
   (setq dir   (strcat (vl-string-right-trim "\" (vl-filename-directory item)) "\")
         match (substr item (1+ (strlen dir)))
         lst   (vl-directory-files dir match 1)
   )
   (foreach fil lst
     (setq files (cons (strcat dir fil) files))
   )
 )
 (reverse files)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function to split a string on a specified character
(defun strsplit (c str / lst p n)
 (setq n 0)
 (while (setq p (vl-string-search c str n))
   (setq lst (cons (substr str (1+ n) (- p n)) lst))
   (setq n (1+ p))
 )
 (if (< n (strlen str))
   (setq lst (cons (substr str (1+ n)) lst))
 )
 (reverse lst)
)