社区 › Auto Lisp › 带d的力层平移

woodman78 发表于 2022-7-6 09:17:48

带d的力层平移

我有这个代码来处理调查，当我运行它时，laytrans不会运行。有人看到我丢了什么吗？
 

(defun c:survey_transform ()
; First construct our entity list
(setq vl1 (list
(cons 0 "LAYER");Name of entity
(cons 100 "AcDbSymbolTableRecord")   ;Open Records
(cons 100 "AcDbLayerTableRecord")   ;Locate Layer Table
(cons 2 "CCC_SURVEY_EXISTING_Feature")    ;Name of Layer
(cons 6 "Continuous")      ;Linetype
(cons 62 150)       ;colour = light grey
(cons 70 0)       ;state
(cons 290 1)       ;1=plot, 0=Don't plot
)       ;End of entity list
)
(entmake vl1)
(setq vl1 (list
(cons 0 "LAYER");Name of entity
(cons 100 "AcDbSymbolTableRecord")   ;Open Records
(cons 100 "AcDbLayerTableRecord")   ;Locate Layer Table
(cons 2 "CCC_SURVEY_EXISTING_Number")    ;Name of Layer
(cons 6 "Continuous")      ;Linetype
(cons 62 1)       ;colour = light grey
(cons 70 0)       ;state
(cons 290 1)       ;1=plot, 0=Don't plot
)       ;End of entity list
)
(entmake vl1)
(setq vl1 (list
(cons 0 "LAYER");Name of entity
(cons 100 "AcDbSymbolTableRecord")   ;Open Records
(cons 100 "AcDbLayerTableRecord")   ;Locate Layer Table
(cons 2 "CCC_SURVEY_EXISTING_Level")    ;Name of Layer
(cons 6 "Continuous")      ;Linetype
(cons 62 84)       ;colour = light grey
(cons 70 0)       ;state
(cons 290 1)       ;1=plot, 0=Don't plot
)       ;End of entity list
)
(entmake vl1)
(setq vl1 (list
(cons 0 "LAYER");Name of entity
(cons 100 "AcDbSymbolTableRecord")   ;Open Records
(cons 100 "AcDbLayerTableRecord")   ;Locate Layer Table
(cons 2 "CCC_SURVEY_Level")   ;Name of Layer
(cons 6 "Continuous")      ;Linetype
(cons 62 84)       ;colour = light grey
(cons 70 0)       ;state
(cons 290 1)       ;1=plot, 0=Don't plot
)       ;End of entity list
)
(entmake vl1)
(setq vl1 (list
(cons 0 "LAYER");Name of entity
(cons 100 "AcDbSymbolTableRecord")   ;Open Records
(cons 100 "AcDbLayerTableRecord")   ;Locate Layer Table
(cons 2 "CCC_SURVEY_Number")   ;Name of Layer
(cons 6 "Continuous")      ;Linetype
(cons 62 1)       ;colour = light grey
(cons 70 0)       ;state
(cons 290 1)       ;1=plot, 0=Don't plot
)       ;End of entity list
)
(entmake vl1)
; First construct our entity list
(setq vl1 (list
(cons 0 "LAYER");Name of entity
(cons 100 "AcDbSymbolTableRecord")   ;Open Records
(cons 100 "AcDbLayerTableRecord")   ;Locate Layer Table
(cons 2 "CCC_SURVEY_Feature")   ;Name of Layer
(cons 6 "Continuous")      ;Linetype
(cons 62 150)       ;colour = light grey
(cons 70 0)       ;state
(cons 290 1)       ;1=plot, 0=Don't plot
)       ;End of entity list
)
(entmake vl1)
(and (setq ss (ssget "X" '((8 . "*CODE"))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Feature" ""))
(and (setq ss (ssget "X" '((8 . "*ID"))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Number" ""))
(and (setq ss (ssget "X" '((8 . "*_Z"))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))
(and (setq ss (ssget "X" '((8 . "*Points"))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_EXISTING_Level" ""))
(and (setq text1(ssget "x" (list '(0 . "TEXT") (cons 62 70))))
(command "_.CHPROP" TEXT1 "" "_LA" "CCC_SURVEY_Level" ""))
(and (setq text2(ssget "x" (list '(0 . "TEXT") (cons 62 12))))
(command "_.CHPROP" TEXT2 "" "_LA" "CCC_SURVEY_Number" ""))
(and (setq text3(ssget "x" (list '(0 . "TEXT") (cons 62 152))))
(command "_.CHPROP" TEXT3 "" "_LA" "CCC_SURVEY_Feature" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 70))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Level" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 12))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Number" ""))
(and (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 62 152))))
    (command "_.CHPROP" ss "" "_LA" "CCC_SURVEY_Feature" ""))
(command "_.CHPROP" "all" "" "C" "BYLAYER" "")
(command "_.-layer" "_C" "84" "CCC_SURVEY_Level" "_C" "150" "CCC_SURVEY_Feature" "" )
(acet-laytrans "CCC_Survey.dws" (+ 1 2))
(command "_-purge" "a" "*" "N")
(princ)
)

BlackBox 发表于 2022-7-6 09:23:41

（你的日常生活）远比它需要的复杂。。。我希望我现在有时间帮助重写。也许有人会打败我。有一种更简单的方法来完成这些任务，我的朋友。

woodman78 发表于 2022-7-6 09:27:01

其他人能帮上忙吗？

irneb 发表于 2022-7-6 09:30:05

这里有一种方法。我已经多次看到这个问题了，我只是决定做一些我想要的东西：
命令为ImportLayers。
 
其思想是将图层与源DWG/DWT/DWS文件的图层相匹配。虽然可以通过多种方法导入，但这种方法也允许更新现有图层以进行匹配-类似于“图形标准”命令，但可以编写脚本。
 
如果始终将特定DWG文件作为源，则可以修改（setq*ImportLayersFrom*nil）以设置默认源。E、 如果你的文件是MyTemplate。DWT在文件夹C:\Myfiles中，则应为：
请注意双反斜杠！
 
默认情况下，仅导入新图层，而不导入线型。“更新”选项用于打开/关闭更新现有图层，而“导入”选项用于导入线型。
 
它“应该”也适用于在多个DWG上编写脚本，但（在这种情况下）我建议使用普通的lisp defun，因此：
(ImportLayers "C:\\Myfiles\\MyTemplate.DWT" T T)最后2个T表示更新和导入，如果您想关闭它们，请将T更改为nil。

woodman78 发表于 2022-7-6 09:33:44

谢谢你的帮助。这太棒了。

Lee Mac 发表于 2022-7-6 09:37:19

也许这会有所帮助：
 
http://lee-mac.com/steal.html

irneb 发表于 2022-7-6 09:40:17

很好，李。这实际上是我想把代码带到的地方，但像往常一样，有人打败了我！和往常一样，是你！尽管我认为很多其他人已经有了类似的代码（我相信alan已经有几年这样的代码了）！

Lee Mac 发表于 2022-7-6 09:45:22

关键是“CopyObjects”，使您不必匹配所有属性：眨眼：

irneb 发表于 2022-7-6 09:48:24

谢谢，是的，这对块定义之类的事情很有效。但是，当您想重新定义（而不仅仅是导入新的）样式/层时会发生什么？
 
顺便说一句，我正在寻找直接从DBX重新定义线型的方法。因为可能有一个自定义线型，我可能不知道它来自哪个LIN文件。我可以通过修改DXF代码来“重新定义”线型样式，但不可能获得DBX连接线型的DXF代码。
 
这件事对我来说是一个棘手的问题。E、 g.我们有一些项目，其中英寸/毫米在顾问之间混合/甚至只是合同的不同部分。由于各种原因，我本想摆脱这一点，但不能。现在英寸图形的线型来自ACAD。林，而mm图纸来自阿卡迪索。LIN（以及其他自定义LIN文件）。如果将英寸DWG外部参照（例如）为毫米DWG，则线型不匹配（并且无法通过ACad的常用对话框修改这些XrefName$LinetypeName线型）。
 
只有两种药剂：
 
[列表=1]
[*]从mm的定义文件中重新加载inch DWG内的线型。保存并转到mm DWG，将VisRetain设置为0，重新加载外部参照，将VisRetain设置为1。返回英寸DWG并从英寸定义文件重新加载线型。但这太愚蠢了，因为您失去了对外部参照图层所做的任何图层设置，这些设置可以通过一些lisp替换，但其余的不能通过lisp完成。
[*]有一些自定义线型名称列表，说明它们来自哪个文件。逐步浏览mm DWG中的所有外部参照线型并提取原始线型名称，然后从保存的列表中找出重新加载它们的位置（ACADISO.LIN或某些自定义的.LIN）。重新加载该文件中的所有文件。获取其DXF数据，然后将外部参照线型的DXF数据替换为相同的数据。
[/列表]
至少第2点可以合理地工作，如果没有自定义线型，则操作相当简单。但最坏的情况是你没有这个习惯。LIN文件可用-则两种解决方案都不起作用。
 
编辑！刮一下！我刚试过！可以在dbx对象上使用vlax vla object->ename函数，然后使用entget！：Dyippeeee！！！

stevesfr 发表于 2022-7-6 09:51:18

irneb，我似乎无法从源dwg导入线型。我会做错什么？它们都是连续的！
TIA，Steve

查看完整版本: 带d的力层平移