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

ASMI 发表于 2022-7-6 07:06:38

(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? <Yes>: "))
(if(null cAns)(setq cAns "Yes"))
(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 "ID: "(itoa(vla-get-ObjectID plObj))
         "\nMaterial: " dwrite:material
         "\nLength: " (rtos(vlax-curve-GetDistAtParam plObj
                        (vlax-curve-GetEndParam plObj)))))
(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 "ID: "(itoa(vla-get-ObjectID plObj))
      "\nMaterial: " dwrite:material
      "\nLength: " (rtos(vlax-curve-GetDistAtParam plObj
                  (vlax-curve-GetEndParam plObj)))))
   (princ "\n<<< Data successfuly added >>> ")
   ); end progn
); end if
(princ)
); c:dwrite

(defun c:dcollect(/ plSet oLst cDat fDescr 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-ObjectID pl)
      (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 "Pipe ID;Diameter;Layer;From;To;Material;Length" fDescr)
(foreach itm (reverse oLst)
      (write-line(strcat (itoa(nth 0 itm))
";" (strcat(rtos(* 1000.0(nth 1 itm)))
";" (nth 2 itm)
";" (nth 3 itm)
";" (nth 4 itm)
";" (nth 5 itm)
";" (rtos(nth 6 itm)))
   ); end strcat
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

(defun c:ddata(/ cEnt cDat cPln)
(if(setq cEnt(entsel "\nSelect polyline to view data: "))
(if(= "LWPOLYLINE"(cdr(assoc 0(entget(car cEnt)))))
(if(setq cDat(vlax-ldata-get(setq cPln(vlax-ename->vla-object(car cEnt))) "PipeData"))
(alert(strcat
"                PIPE DATA             \n"
"\nPipe ID: " (itoa(vla-get-ObjectID cPln))
"\nDiameter: " (rtos(* 1000.0(vla-get-ConstantWidth cPln)2 0))
"\nLayer: " (vla-get-Layer cPln)
"\nFrom: " (cdr(assoc 1 cDat))
"\nTo: " (cdr(assoc 2 cDat))
"\nMaterial: " (cdr(assoc 3 cDat))
"\nLength: " (rtos(vlax-curve-GetDistAtParam cPln
            (vlax-curve-GetEndParam cPln)))
); end strcat
   ); end alert
(princ "\nNo data found! ")
); end if
(princ "\nThis isn't LwPolyline! ")
); end if
(princ "\nNothing selected! ")
); end if
(princ)
); end of c:ddata

(defun c:ddelete(/ cCnt cAns plSet cDat hyCol cHyp)
(initget 1 "All Selection")
(setq cAns(getkword "\nWhich data to delete : ")
cCnt 0)
(if(= cAns "All")
(setq plSet(ssget "_X" '((0 . "LWPOLYLINE"))))
(setq plSet(ssget '((0 . "LWPOLYLINE"))))
); end if
(getstring "\n*** WARNING! All data will deleted. Enter to Continue or Esc to Quite. ***")
(if plSet
(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
(vlax-ldata-delete pl "PipeData")
(setq cCnt(1+ cCnt))
); end progn
); end if
      (vlax-for hy(vla-get-Hyperlinks pl)
   (if(= "Has Pipe Data"(vla-get-URL hy))
(vla-Delete hy)
); end vlax-for
   ); end vlax-for
); end foreach
(if(/= 0 cCnt)
(princ(strcat "\n<<< " (itoa cCnt) " item(s) was deleted >>> "))
(princ "\nNothing data found! ")
); end if
); end progn
); end if
(princ)
); end of c:ddelete

(vl-load-com)

数据写入-写入数据
数据收集-将数据放入*。csv文件
DDATA-查看数据
删除-删除所有或选定的数据

ASMI 发表于 2022-7-6 07:08:06

福格特说。在测试当前版本之前，请使用DDELETE命令删除所有旧数据。

feargt 发表于 2022-7-6 07:12:03

再次感谢阿斯米，我明天会在办公室试用，并给你任何反馈。非常感谢您的帮助。

The Buzzard 发表于 2022-7-6 07:15:03

很好的ASMI编码，

但我很好奇。是否有方法更改已附加的现有数据，并且可以将每个数据块打包到单独的单元格中。看起来，如果您想更改对象上的现有数据，您需要删除该对象并重新开始，因此我认为以这种方式附加数据没有多大优势。

不管怎样，做得很好，
谢谢你的帖子
它们信息量很大。
秃鹰

feargt 发表于 2022-7-6 07:19:38

在asmi的代码中，可以覆盖现有数据，它将首先询问用户是否希望覆盖数据。

The Buzzard 发表于 2022-7-6 07:22:07

太好了，

但是，如果将多个数据附加到同一个对象，如何调用特定的数据段进行覆盖？
它是否会提示您输入所附的所有数据？

The Buzzard 发表于 2022-7-6 07:26:38

好啊

我现在明白了，很抱歉。很棒的节目！。
但是仍然有办法将数据打包到电子表格中的各个单元格中吗？

ASMI 发表于 2022-7-6 07:29:15

对

这些，因此在单独的单元格中（在关联列表（（标记数据）…）中）并在CSV文件的单独单元格中提取。

不需要删除对象，只删除数据。但你不能只删除和添加数据。理论上，你可以把英国百科全书添加到折线中，而且，每一章都在他的单元中。

你能建议其他方法吗？是的，它们存在。例如，链接到扩展数据中的数据库。但在这种情况下，最好使用字典，因为数据量较低，并且数据库不存在。

The Buzzard 发表于 2022-7-6 07:31:25

谢谢你，这是一条信息量很大的帖子。

ASMI 发表于 2022-7-6 07:35:10

一个单元格中的数据？

在本例中，我在其中使用了一个键和一个关联列表，但您可以使用其中的许多键和各种数据，并且可以单独访问。

页: 1 [2]

乐筑天下's Archiver