坐标数据展点在CAD
cad平台上测绘中VBA展野外点点号和方位角
下面就是自动在AutoCAD中画点的Visual Basic程序代码(部分),最后将其制作成可执行文件(e: \展点.exe)供AutoCAD菜单宏调用。 假若数据采集格式为: 点号,X坐标,Y坐标, Z(高程) Open数据文件名For Input As #1 set Points = https://www.wendangku.net/doc/5f14884881.html,yers.Add(/点0)-增加/点0图层Points.Color = acBlue Set Heights = https://www.wendangku.net/doc/5f14884881.html,yers.Add(/高程0)-增加/高程0图层Heights.Color = acGreen Set nos = https://www.wendangku.net/doc/5f14884881.html,yers.Add(/点号0) -增加/点号0图层 nos.Color = acRed Do While Not EOF(1) Input #1, NO, x, y, z -将文件中数据分别附值 给这几个变量 Pt(0) = y: Pt(1) = x: Pt(2) = 0 -测量坐标系与 AutoCAD坐标系的区别 Set AdPoint = modelobj.AddPoint(Pt) -在模型空间中画点https://www.wendangku.net/doc/5f14884881.html,yer =/点0 SetAdNO = modelobj.AddText(Str(NO), Pt, 1#)-在模型空 间中绘制点号 https://www.wendangku.net/doc/5f14884881.html,yer =/点号0 Ht(0) = y + 0.9: Ht(1) = x: Ht(2) = 0 Set AdHeight = modelobj.AddText(Str(z), Ht, 2#) https://www.wendangku.net/doc/5f14884881.html,yer =/高程0 Loop Close #1 acapp1.Application.ZoomExtents Form1.Visible = False End Sub 将展成的点连线的VBA代码为: Set PtLine = https://www.wendangku.net/doc/5f14884881.html,yers.Add(/点连线0) PtLine.color = acCyan Dim k Dim Coord As Variant For Each entry In ThisDrawing.ModelSpace If entry.EntityType = acPoint Then i = i + 1 End If Next -获取模型空间中的点数目 ReDim entrycopys(i -1, 2) -根据获得的点数目重新定义数组维数 k = 0
CAD展点程序lisp
CAD展点程序lisp 2009年02月17日星期二 01:08 P.M. （1） 依网上资源文件修改的： －－－－－－－－－－－－－－－－－－－－－－ CAD展点程序 把下文保存到文本文件中，扩展名改为.lsp, 按数据格式要求准备好数据点文件。 在CAD中加载lsp文件。运行命令：kszd －－－－－－－－－－－－－－－－－－－－－－ ;LISP展点程序 ;展1000点：在H P(AMD Athlon64 3000+ 256MB)电胶上仅耗时0.142秒； ; 在金利(Geleron(R) CPU 2.40GHz 256MB)电胶上耗时0.882秒 ;数据文件格式为：每一点的数据（点号、X、Y、H）为一行，用逗号或空格作为分隔符，即;点号1 X1 Y1 H1 或者点号1, X1, Y1, H1 ;点号2 X2 Y2 H2 或者点号2, X2, Y2, H2 ;点号3 X3 Y3 H3 或者点号3, X3, Y3, H3 ;...... ;点号n Xn Yn Hn 或者点号n, Xn, Yn, Hn1 (defun c:kszd() (setq ff (open (getfiled "请选择要展点的数据文件" "" "txt" 2) "r") fhb nil t0 (getvar "cdate") cm (getvar "cmdecho") os (getvar "osmode") tcm1 "高程注记" tcm2 "点记" ) (setvar "cmdecho" 0)(setvar "osmode" 0) (if (= (tblsearch "layer" tcm1) nil) (command "layer" "n" tcm1 "")) (if (= (tblsearch "layer" tcm2) nil) (command "layer" "n" tcm2 "")) (while (setq zb (read-line ff)) (while (vl-string-search "," zb) (setq zb (vl-string-subst " " "," zb))) (setq zb (read (strcat "(" zb ")")) zb (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string (last zb)));注记高程 ;zb (list (list (nth 2 zb) (nth 1 zb)) (vl-princ-to-string (car zb)));提示：注记点号请用该行 fhb (append fhb (list zb)) ) ) (setq t1 (getvar "cdate")) (close ff) (setq zb (vl-sort fhb '(lambda (e1 e2) (< (car (car e1)) (car (car e2))))) x0 (car (car (car zb))) x1 (car (car (last zb))) zb (vl-sort fhb '(lambda (e1 e2) (< (cadr (car e1)) (cadr (car e2)))))