如何在cad里面通过excel依次展线，展点是可以的，并且设置线的颜色和图层
本帖最后由 君是我的泪 于 2019-7-15 09:26 编辑VBA执行，alt+f11运行
C行代表线号
D行代表点号
E行可表示图层
A x轴
B y轴
源文件亲测可试，在此基础上增加筛选展线功能，用来将每一条线分解成多段，分颜色表示
看不懂，画个和数据对应的示例图 不错的工具，可以方便使用、也可以帮助大家学习代码 st788796 发表于 2019-7-15 09:44
看不懂，画个和数据对应的示例图
4578.535857.09834578.5349,857.0983pllayer10,255,255
16458.53857.098316458.5349,857.0983pllayer10,255,255
16458.5315988.8716458.5349,15988.8722pllayer2255,255,0
4578.53515988.874578.5349,15988.8722pllayer2255,255,0
4578.535857.09834578.5349,857.0983pllayer2255,255,0
本例为一种思路，供参考。注： EXCEL文件的F列必须设置为文本
(defun c:exht (/ xl fl fn lst p0 p1 tc ys)
(vl-load-com)
(setvar "cecolor" "bylayer")
(defun Excel-Get-CellValue (xl cell)
(setq xlsval (vlax-variant-value (vlax-get-property (vlax-get-property xl "range" cell) "Value"))))
(setq fl (getfiled "选择数据文件" "" "xls" 8))
(if (setq fn (findfile fl))
(if (setq xl (vlax-get-or-create-object "Excel.Application"))
(progn
(vlax-invoke-method (vlax-get-property xl 'WorkBooks) 'Open fn)
;;; (vla-put-visible xl 1) ;此行可略去
(setq ii 0 lst nil)
(while (setq dyg (Excel-Get-CellValue xl (strcat (chr (+ 65 ii)) "1") ) )
(setq lst (cons dyg lst) ii (1+ ii)) ) ;读入第1行，组成LIST
(setq lst (reverse lst) p0 (list (nth 0 lst)(nth 1 lst))) ;取得坐标
(setq jj 2)
(while (Excel-Get-CellValue xl (strcat "A" (rtos jj)))
(setq ii 0 lst nil)
(while (setq dyg (Excel-Get-CellValue xl (strcat (chr (+ 65 ii)) (rtos jj)) ) )
(setq lst (cons dyg lst) ii (1+ ii)) ) ;读入后续行数据，组成LIST
(setq lst (reverse lst)
p1 (list (nth 0 lst)(nth 1 lst)) ;取得坐标
tc (nth 4 lst) ;取得图层名
ys (read (vl-string-translate "," " " (strcat "(" (nth 5 lst) ")"))));组成RGB值LIST
(if (not (tblsearch "layer" tc))(command "layer" "n" tc ""));建立新的图层
(vl-cmdf "layer" "s" tc "");将新建的图层置为当前层
(setq acCmColo (vla-getinterfaceobject (vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor." (substr (getvar "ACADVER") 1 2))))
(vlax-invoke-method acCmColo "SetRGB" (car ys) (cadr ys) (last ys));建立RGB颜色
(vlax-for Layer (vla-get-Layers ;以下4行置图层RGB颜色
(vla-get-ActiveDocument (vlax-get-acad-object)) )
(if (= (vlax-get-property Layer "name") tc)
(vlax-put Layer "Truecolor" acCmColo)))
(vl-cmdf "pline" p0 p1 "")
;;; (vlax-put-property (vlax-ename->vla-object (entlast)) 'trueCOLOR acCmColo);本行置最后图元的RGB颜色
(setq p0 p1 jj (1+ jj))) ;交换点坐标
(vlax-invoke-method xl 'quit)
(vlax-release-object xl)
(vl-cmdf "regen" "zoom" "e")
);progn
);if
);if
)
(prompt "command: exht")(princ)
本帖最后由 君是我的泪 于 2019-7-19 09:19 编辑
pxr201419 发表于 2019-7-18 08:23
本例为一种思路，供参考。注： EXCEL文件的F列必须设置为文本
(defun c:exht (/ xl fl fn lst p0 p1 tc ys ...
给一个颜色文本的格式，是按照上表来的？excel新建一行依然有效？
pxr201419 发表于 2019-7-18 08:23
本例为一种思路，供参考。注： EXCEL文件的F列必须设置为文本
(defun c:exht (/ xl fl fn lst p0 p1 tc ys ...
能让画出来的线 多条首尾相连吗？也就是pline，这个dxf转化成kml方便点，不然还得选择，可否设置一个switch 本帖最后由 pxr201419 于 2019-7-19 15:12 编辑
那就是说一张表里的数据画一根PLINE ?那E列表示的是什么？一根线不可能在多个图层上 pxr201419 发表于 2019-7-19 15:11
那就是说一张表里的数据画一根PLINE ?那E列表示的是什么？一根线不可能在多个图层上
一条连续的线一个图层，这个是导入奥维地图做kml 用的 pxr201419 发表于 2019-7-19 15:11
那就是说一张表里的数据画一根PLINE ?那E列表示的是什么？一根线不可能在多个图层上
由衷的谢谢
本帖最后由 君是我的泪 于 2019-7-30 15:14 编辑
如何设置一条pl路径，多种line颜色,但首尾相连且连续，可以标注kml上的路径，这又是另一个思路
4578.535857.09831.14578.5349,857.0983,1.1pllayer10,255,255
16458.53857.09832.216458.5349,857.0983,2.2pllayer10,255,255
16458.5315988.871.216458.5349,15988.8722,1.2pllayer2255,255,0
4578.53515988.871.24578.5349,15988.8722,1.2pllayer2255,255,0
4578.535857.09832.24578.5349,857.0983,2.2pllayer2255,255,0
pline 是一个实体，不能每段一个颜色 本帖最后由 君是我的泪 于 2019-7-31 15:11 编辑
st788796 发表于 2019-7-31 06:56
pline 是一个实体，不能每段一个颜色
首尾相连或者首位不相连的line，颜色可以一拉就行，这样可以做到吗？首尾相连，单色应用在等水压线上，不相连可以在奥维kml上
君是我的泪 发表于 2019-7-31 15:09
首尾相连或者首位不相连的line，颜色可以一拉就行，这样可以做到吗？首尾相连，单色应用在等水压线上， ...
您好
請教一下，我下載excel檔後
我執行後出現錯誤的訊息
谢谢分享！！！！！
页:
[1]
2