向多段线和ex添加数据乐筑天下 - Powered by Discuz! Archiver

feargt 发表于 2022-7-6 06:32:53

向多段线和ex添加数据

你好

首先，我想祝大家新年快乐，但对一些人来说，这似乎不是最好的开始，祈祷你们的情况有所改善。

可能已经有一个线程的信息，我正在寻找，但我一直无法找到它。

我在寻找一个lisp文件或VB例程或帮助创建这样一个文件，。。。

在这里，我可以选择一条多段线（例如表示管道）&它会询问我
1号
它从哪里来？

&我可以手动输入数据或从中选择块，它将使用块名称作为数据。

Nr 2
它要去哪里？同样，我可以手动输入数据或从中选择一个块，它将使用块名称作为数据。

Nr 3
它将存储此信息以及多段线的宽度和多段线的图层，以便我可以将此信息提取到表中

在我的搜索过程中，我发现了几种向多边形中添加数据的方法，但不是通过使用数据提取方法来提取数据。它不必使用数据提取方法，但应该可以导出为表格格式

如果您能帮上忙，我们将不胜感激。

这应该适用于普通Autocad 2008以上版本。

希望我已经解释清楚了

谢谢

Lee Mac 发表于 2022-7-6 06:37:12

我不知道你可以给折线添加额外的信息-我很想看看结果

ASMI 发表于 2022-7-6 06:41:32

非常简单的示例将数据写入和读取到多段线（或任何其他对象）：

(defun c:dwrite(/ plObj stBl enBl datLst)
(vl-load-com)
(if
(and
(setq plObj(entsel "\nSelect polyline to write > "))
(setq stBl(entsel "\nSelect 'start' block > "))
(setq enBl(entsel "\nSelect 'end' block > "))
); end and
(progn
(setq plObj(vlax-ename->vla-object(car plObj))
stBl(cdr(assoc 2(entget(car stBl))))
enBl(cdr(assoc 2(entget(car enBl))))
datLst(list(cons 1 stBl)(cons 2 enBl))
); end setq
(vlax-ldata-put plObj "Pipe Data" datLst)
); end progn
);end if
(princ)
); c:dwrite

(defun c:dread(/ rObj datLst)
(vl-load-com)
(if(and
   (setq rObj(entsel "\nSelect polyline to read > "))
   (setq datLst(vlax-ldata-get(car rObj) "Pipe Data"))
   ); and
(alert(strcat "Start block: "(cdr(assoc 1 datLst))
            "\n\nEnd block: "(cdr(assoc 2 datLst))))
(alert "\nNo data found. ")
); end if
(princ)
); end of c:dread

Lee Mac 发表于 2022-7-6 06:44:32

干杯，阿斯米，很高兴知道

ASMI 发表于 2022-7-6 06:46:48

带有超链接提示的新变体，并将数据保存到*。csv文件。DWRITE-将数据添加到多段线，DCOLLECT-读取到*。csv文件（用MS Excel打开）。

(defun c:dwrite(/ plObj stBl enBl datLst cAns hyObj)
(if
(and
(setq plObj(entsel "\nSelect polyline to write > "))
(setq stBl(entsel "\nSelect 'Begin' block > "))
(setq enBl(entsel "\nSelect 'End' block > "))
); end and
(progn
(setq plObj(vlax-ename->vla-object(car plObj))
stBl(cdr(assoc 2(entget(car stBl))))
enBl(cdr(assoc 2(entget(car enBl))))
datLst(list(cons 1 stBl)(cons 2 enBl))
hyObj(vla-get-Hyperlinks plObj)
); end setq
(if(vlax-ldata-get plObj "Pipe Data")
(progn
(initget "Yes No")
(setq cAns(getkword "\nPipe data already exists. Overwrite? : "))
(if(= "Yes" cAns)
(progn
(vlax-ldata-delete plObj "Pipe Data")
(vlax-ldata-put plObj "Pipe Data" datLst)
(vla-Delete(vla-Item hyObj 0))
(vla-Add hyObj "Has Pipe Data" (strcat "Pipe: " stBl " --> " enBl))
(princ "\nData successfuly added ")
);end progn
); end if
); end progn
(progn
   (vlax-ldata-put plObj "Pipe Data" datLst)
   (vla-Add hyObj "Has Pipe Data" (strcat "Pipe: " stBl " --> " enBl))
   (princ "\nData successfuly added ")
   ); end progn
); end if
); end progn
);end if
(princ)
); c:dwrite

(defun c:dcollect(/ plSet oLst cDat fName cAns exApp wbCol cDoc)
(if(setq plSet(ssget "_X" '((0 . "LWPOLYLINE"))))
(progn
(foreach pl (mapcar 'vlax-ename->vla-object
               (vl-remove-if 'listp
                  (mapcar 'cadr(ssnamex plSet))))
(if(setq cDat(vlax-ldata-get pl "Pipe Data"))
(progn
(setq oLst(cons
(list
      (vla-get-ConstantWidth pl)
      (vla-get-Layer pl)
      (cdr(assoc 1 cDat))
      (cdr(assoc 2 cDat))
   ); end list
      oLst); end cons
   ); end setq
); end progn
); end if
); end foreach
(if oLst
(progn
(setq fDescr(open
(setq fName(strcat(vl-filename-directory(getvar "SAVENAME"))
   "\\"(vl-filename-base(getvar "DWGNAME")) ".csv")) "w"))
(write-line "Diameter;Layer;From;To" fDescr)
(foreach itm (reverse oLst)
   (write-line (strcat(rtos(car itm))
";" (cadr itm)
";" (nth 2 itm)
";" (last itm))
fDescr)
); end foreach
(close fDescr)
(princ(strcat "\nCSV file location: " fName ))
(initget "Yes No")
(setq cAns(getkword "\nOpen file : "))
(if(= cAns "Yes")
(if(setq exApp(vlax-get-or-create-object "Excel.Application"))
   (progn
(vlax-put-property exApp 'Visible :vlax-true)
   (setq wbCol(vlax-get-property exApp 'Workbooks)
      cDoc(vlax-invoke-method wbCol 'Open fName))
(vlax-release-object cDoc)
(vlax-release-object wbCol)
(vlax-release-object exApp)
); end progn
   ); end if
); end if
); end progn
); end if
); end progn
); end if
(princ)
); end of c:dtable

(vl-load-com)

Hiperlinks只是带有管道方向的提示，CTRL+单击不起作用。它显示了数据如何仅存在。

feargt 发表于 2022-7-6 06:50:24

谢谢Asmi，

太棒了！！你总是让我惊讶，这是肯定的。我已经测试了你的修订版本。当然，只有在测试之后，我才意识到我应该首先考虑的额外的几点。我将列出几点，如果你有时间可以实现它们，如果你可以在lisp文件中添加注释来显示你是如何进行更改的，那就更好了。

1、不总是有开始块，也不总是有结束块。当没有可供选择的块时，是否可以将该数据作为文本字符串输入？

2、这里是我的错，但我完全忘记了我需要导出的主要数据之一。这是多段线的长度

3.在导出过程中，是否可以将constantwidth乘以1000，并在数字前加上DN（例如，宽度恒定为0.2的多段线将导出为DN 200。这并不太重要，因为我可以在excel中作为宏的一部分来格式化.csv文件。但很高兴看到它是如何实现的。

4、这只是我在测试时想到的。是否可以创建一个选项来请求管道材料？如果材料未知，则记录默认值“不可用”？

1和2是需要的，3和4是一个愿望，如果这样的事情是允许的，将不胜感激。

再次感谢阿斯米，

费尔格特

Lee Mac 发表于 2022-7-6 06:52:44

阿斯米，你是个天才。

ASMI 发表于 2022-7-6 06:57:46

我似乎已经实现了你的愿望，但可能会有错误，因为它的'飞行'的代码。它没有受到严格的检查。在代码开头修改材料列表和默认材料。与之前一样的命令DWRITE和DCOLLECT。可能有必要提供删除数据和超链接的命令，但现在不是这样。

(defun c:dwrite(/ plObj stBl enBl datLst cAns hyObj okFlg cMat mLst mNum)

; ************ MODIFY LIST OF MATERIALS ************

(setq mLst '(
   (0 . "N/A")
   (1 . "DIN 2391")
   (2 . "DIN 2392")
   (3 . "DIN 2394")
   )
); end setq

; ************ MODIFY DEFAULT MATERIAL ************

(if(not dwrite:material)
(setq dwrite:material "N/A")
); end if

(defun Entsel_or_Text(Spaces Message / lChr tStr grLst filPt
selSet outVal pSps)
(princ Message)
(setq tStr ""); end setq
(if Spaces
(setq pSps(list "\r"))
(setq pSps(list " " "\r"))
); end if
(while
(and
   (not(member lChr pSps))
(/= 3(car grLst))
   ); end and
(if
   (setq grLst(grread nil 4 2))
   (progn
   (cond
      ((= 3(car grLst))
      (setq filPt(cadr grLst)
            selSet(ssget filPt)
            ); end setq
      (if selSet
            (setq outVal
            (list(ssname selSet 0)filPt))
         ); end if
      ); end condition #1
((or
(equal '(2 13) grLst)
(equal 25(car grLst))
); end or
(setq lChr "\r"
   outVal tStr); end setq
); end condition #2
((and
(equal '(2grLst)
(< 0(strlen tStr))
); end and
(setq tStr(substr tStr 1(1-(strlen tStr))))
(princ(strcat(chr (chr 32)(chr ))
); end condition #3
      ((and
(= 2(car grLst))
(<= 32(cadr grLst)126)
); end and
      (setq lChr(chr(cadr grLst)))
      (if(not(member lChr pSps))
            (progn
            (setq tStr(strcat tStr lChr)
                  outVal tStr); end setq
         (princ lChr)
      ); end progn
      ); end if
   ); end condition #4
   ); end cond
   ); end progn
); end if
); end while
outVal
); end of Entsel_or_Text

(while(not okFlg)
(princ(strcat "\nCurrent material = " dwrite:material))
(setq plObj(Entsel_or_Text T "\nSelect polyline or : "))
(cond
((and
(= 'LIST(type plObj))
(= "LWPOLYLINE"(cdr(assoc 0(entget(car plObj)))))
); end and
   (setq plObj(car plObj)
okFlg T); end setq
   ); end condition #1
((= 'LIST(type plObj))
   (princ "\nThis isn't LwPolyline! ")
   ); end condition #2
((and
(= 'STR(type plObj))
(member(strcase plObj) '("M" "_M" "MATERIAL" "_MATERIAL"))

); end and
   (textscr)
   (princ "\n====== MATERIAL LIST ======")
   (foreach m mLst
(princ(strcat "\n[" (itoa(car m)) "] - "(cdr m)))
); end foreach
   (princ "\n===========================")
   (setq mNum(getint "\nSelect material from list: "))
   (if(and mNum(setq cMat(assoc mNum mLst)))
(progn
(setq dwrite:material(cdr cMat))
(graphscr)
); end progn
(princ "\nCan't find material with this number! ")
); end if
   ); end condition #3
((null plObj)
   (princ "\nEmpty selection! ")
   ); end condition #4
(T
   (princ "\nInvalid keyword option! ")
   ); end condition #5
); end cond
); end while
(while(not stBl)
(setq stBl(Entsel_or_Text T "\nSelect 'Begin' block or type name: "))
(cond
((and
(= 'LIST(type stBl))
(= "INSERT"(cdr(assoc 0(entget(car stBl)))))
); end and
   (setq stBl(cdr(assoc 2(entget(car stBl)))))
   ); end condition #1
((= 'LIST(type stBl))
   (princ "\nThis isn't block! ")
   (setq stBl nil)
   ); end condition #2
((null stBl)
   (princ "\nEmpty input! ")
   ); end condition #3
); end cond
); end while
(while(not enBl)
(setq enBl(Entsel_or_Text T "\nSelect 'End' block or type name: "))
(cond
((and
(= 'LIST(type enBl))
(= "INSERT"(cdr(assoc 0(entget(car enBl)))))
); end and
   (setq enBl(cdr(assoc 2(entget(car enBl)))))
   ); end condition #1
((= 'LIST(type enBl))
   (princ "\nThis isn't block! ")
   (setq enBl nil)
   ); end condition #2
((null enBl)
   (princ "\nEmpty input! ")
   ); end condition #3
); end cond
); end while
(setq datLst(list(cons 1 stBl)(cons 2 enBl)(cons 3 dwrite:material))
plObj(vlax-ename->vla-object plObj)
hyObj(vla-get-Hyperlinks plObj)
); end setq
(if(vlax-ldata-get plObj "PipeData")
(progn
(initget "Yes No")
(setq cAns(getkword "\nPipe data already exists. Overwrite? : "))
(if(= "Yes" cAns)
(progn
(vlax-ldata-delete plObj "PipeData")
(vlax-ldata-put plObj "PipeData" datLst)
(vla-Delete(vla-Item hyObj 0))
(vla-Add hyObj "Has Pipe Data" (strcat "Material: " dwrite:material))
(princ "\n<<< Data successfuly added >>> ")
);end progn
); end if
); end progn
(progn
   (vlax-ldata-put plObj "PipeData" datLst)
   (vla-Add hyObj "Has Pipe Data" (strcat "Material: " dwrite:material))
   (princ "\n<<< Data successfuly added >>> ")
   ); end progn
); end if
(princ)
); c:dwrite

(defun c:dcollect(/ plSet oLst cDat fName cAns exApp wbCol cDoc)
(if(setq plSet(ssget "_X" '((0 . "LWPOLYLINE"))))
(progn
(foreach pl (mapcar 'vlax-ename->vla-object
               (vl-remove-if 'listp
                  (mapcar 'cadr(ssnamex plSet))))
(if(setq cDat(vlax-ldata-get pl "PipeData"))
(progn
(setq oLst(cons
(list
      (vla-get-ConstantWidth pl)
      (vla-get-Layer pl)
      (cdr(assoc 1 cDat))
      (cdr(assoc 2 cDat))
      (cdr(assoc 3 cDat))
      (vlax-curve-GetDistAtParam pl
      (vlax-curve-GetEndParam pl))
   ); end list
      oLst); end cons
   ); end setq
); end progn
); end if
); end foreach
(if oLst
(progn
(setq fDescr(open
(setq fName(strcat(vl-filename-directory(getvar "SAVENAME"))
   "\\"(vl-filename-base(getvar "DWGNAME")) ".csv")) "w"))
(write-line "Diameter;Layer;From;To;Material;Length" fDescr)
(foreach itm (reverse oLst)
   (write-line (strcat(rtos(* 1000.0(nth 0 itm)))
";" (nth 1 itm)
";" (nth 2 itm)
";" (nth 3 itm)
";" (nth 4 itm)
";" (rtos(nth 5 itm)))
fDescr)
); end foreach
(close fDescr)
(princ(strcat "\nCSV file location: " fName ))
(initget "Yes No")
(setq cAns(getkword "\nOpen file : "))
(if(= cAns "Yes")
(if(setq exApp(vlax-get-or-create-object "Excel.Application"))
   (progn
(vlax-put-property exApp 'Visible :vlax-true)
   (setq wbCol(vlax-get-property exApp 'Workbooks)
      cDoc(vlax-invoke-method wbCol 'Open fName))
(vlax-release-object cDoc)
(vlax-release-object wbCol)
(vlax-release-object exApp)
); end progn
   ); end if
); end if
); end progn
(princ "\nNo data found! ")
); end if
); end progn
); end if
(princ)
); end of c:dcollect

(vl-load-com)

feargt 发表于 2022-7-6 07:00:41

你好，阿斯米，

太棒了，我今天早上一直在测试

到目前为止，我只有两条值得注意的评论

1.在某些情况下，同一层上有1条以上的管道（多段线）从同一起始块到同一结束块，也可能具有相同的长度。问题是如何最好地区分管道？每个入口的单独管道ID在这里效果最好吗？
我在想一个类似于材料列表的东西，比如一个图层列表

第1层“01001”
第2层“02002”

然后，对于在第1层上选择的每个管道，第一个管道获得ID 01001，第二个管道获得01002，第三个管道获得01003，依此类推

这只是一个建议，因为我不知道这个问题最容易的解决方法是什么。根据你的经验，你很可能会对此有更好的想法或解决方案。

2.这一点与程序无关，只是一个更高的要求，以便使用lisp文件更容易。在超链接中，如果一个人也能读取所有数据，即层、长度和管道ID，那该多好？
目前正在显示

材料：不适用

我已经改变了这一点，它读你的原始版本也

stblk-->enblk？材料：不适用

我也尝试过，但没有成功，包括

stblk-->enblk _材料：不适用_层：XY _长度：10.50管道ID:0101

我非常感谢你迄今为止为我提供的一切。正如u在上次回复中所说，它还需要一种方法来删除超链接和通过lisp文件附加的数据。

在这方面也没有立即的匆忙，无论何时你抽出时间来做这件事都很快，我很感激你会有其他优先事项等等。

当做

费尔格特

ASMI 发表于 2022-7-6 07:04:02

每个实体都有唯一的ObjectID属性。事实是10个字符，你可能看起来很多。如果不合适，你可以考虑其他的。

不幸的是，超链接提示限制了标志的数量并对其进行了修剪。所以我只留下了ID、材质和长度。但现在可以使用DDATA命令查看所有属性。

使用DDELETE命令删除数据和超链接。

事实上，使用它还为时过早，因为它有许多缺点。例如，如果锁定层上的行DWRITE和DDELETE将生成错误。此外，更新超链接所需的命令可能会更改多段线。

页: [1] 2

乐筑天下's Archiver

向多段线和ex添加数据