数字测图实习 - CAD二次开发

数字测图实习 - CAD二次开发

八月 31, 2019

基础知识

形文件的编写

形文件的格式: 最后一行一回车结束；形编号取值1-158；形名称必须大写；形文件的每一行最多可包含128个字符；字节数量表示从第二行开始的短句数目，包括最后的结束符0；一个shp文件中可以包括多个形文件，且与文件名没有关系；

1
2
形编号，字节数量，形名称(大写）
代码1，代码2，···，0

常用格式

1
2
3
4
5
6
7
8
标准矢量 格式：0DF
普通矢量 格式：08,（ Δx,Δy, ）
多段连续的矢量 格式：09,（ Δx,Δy ,··· Δxn,Δyn,0,0 ）
八分圆弧 格式：0A,R,±0SC
普通圆弧 格式：0B,start_offset,end_offset,high_radius,radius,±0SC
普通圆弧 格式：0C, Δx,Δy, ,±凸度      凸度=±127*2H/D
连续圆弧 格式：0D,(Δx1,Δy1, ,±凸度1,···, Δxn,Δyn, ,±凸度n,0,0)
引用子形 格式：07,子形编号

绘制过程：compile load shape

线性文件的编写

简单线型的定义

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
简单线型的定义
标题行：*linetype-name[,description]
描述行：A，patdesc1,patdesc2,patdesc3,······
*：标题行的标记；
A：表示对齐方式,两端对齐；
Patdesci:短划线的长度。若Patdesci>0，表示是实线段长，若Patdesci<0，表示是虚线段长，若Patdesci=0，表示是一个点。

定义嵌入文本的线型
标题行：
*linetype-name[,description]
描述行：
A，p1,p2,···,[“string”,stylename,R=n,A=n,S=n,X=n,Y=n],pi,pi+1,···

R为相对于当前线段的旋转角；A为相对于水平方向的旋转角。两者默认值均为0。
S为比例因子，如果字样为固定高，则S与字样高度相乘；如果字样高度不固定，则S为字样高。S的默认值为1。
X，Y为偏移距离，默认值为0。

定义嵌入符号的线型
标题行：
*linetype-name[,description]
描述行：
A，p1,p2,···,[shapename,shapefile,R=n,A=n,S=n,X=n,Y=n],pi,pi+1,···

填充文件的编写

1
2
3
4
5
6
7
8
9
10
定义CAD图案填充符号
*name
Angle,X-0rgin,Y-orgin,D-L,D-offset,L1,L2,…..
Name：图案名称
Angle：填充线的角度
X-orgin:填充线起点X坐标
Y-orgin :填充线起点Y坐标
D-L：下一根线在长度方向的位移
D-offset：下一根线在垂直方向上的位移
L:线型描述

DAY1 .shp files

窑 32

1
2
3
4
5
6
7
8
9
10
11
12
*01,24,Y
3,10
1,0A,11,022,
4,10,
3,5,
2,0B0,
4,5,
3,10,
1,0A,11,002,
0B4,
4,10,
0

水塔 30

1
2
3
4
5
6
7
8
9
10
11
12
*02,28,ST
2,018,
1,020,
3,5,
2,028,
1,0A4,020,054,058,034,
2,03C,
1,058,05C,020,0AC,
2,0A4,
1,060,
4,5,
0

露天设备 32

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
*03,40,LTSB
3,4,
2,058,
4,4,
3,10,
1,0D4,
4,5,
050,
3,5,
0DC,
4,10,
3,4,
2,058,
4,4,
3,10,
0D4,
1,0C4,
4,10,
3,4,
2,058,
1,0A0,
4,4,
0

水磨坊，水车34

1
2
3
4
5
6
7
8
9
10
11
12
*04,29,SMF
3,10
2,068,
0A,6,040
1,088,084
2,0E0,02C,
1,084,080,
2,0EC,028,
1,080,08C,
2,0E8,024,
1,08C,088,
0

气象台（站）42 4.3.78

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
*05,38,QXZ
3,10,
2,068,
1,0C0,
2,068,
4,10,
1,044,
3,10,
1,0F8,066,
2,06E,
1,06A,
2,062,
2,0F0,
1,0F0,030,066,
2,06E,
1,06A,
2,062,
4,10,
0

停泊场（锚地）62

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
*06,49,TBC
1,
0A,2,-061,
3,5,
01C,
2,014,
1,01F,
2,017,
4,5,
1,
0A,2,052,
3,5,
01C,
2,014,
1,019,
2,011,
4,5,
0A,2,-071,
3,2,
1,044,
3,5,
068,0C0,068,
044,
0A,6,060,
4,10,
0

路标 60

1
2
3
4
5
6
7
8
9
*07,23,LB
1,010,
2,018,
1,034,
1,
3,50,
09,69,40,-69,-40,69,-40,-69,40,0,0,
4,50,
0

电信交接箱 68

1
2
3
4
5
6
7
8
9
10
11
12
13
14
*08,43,DXJJX
2,014,1,
3,2,
09,-1,-2,0,4,1,0,0,-2,0,2,1,0,0,-4,-1,2,0,0,
2,02C,
1,028,
2,014,
1,010,
2,020,
1,010,
2,01C,
1,028,
4,2,
0

信号杆 62

1
2
3
4
5
6
7
8
9
*09,21,XHG
3,2,
1,018,020,018,074,028,040,
3,5,
2,048,
1,08C,
0A,4,020,
4,10,
0

路灯 48

1
2
3
4
5
6
7
8
9
10
*10,24,LD
3,10,
1,078,03C,
0A,4,020,
034,0E0,03C,
0A,4,020,
034,078,0FC,03C,
0A,5,020,
4,10,
0

DAY2 .lin files

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
*xuxian, - - - - -
A,1,-1

*dianhuaxian, __ . __
A,4,-1,0,-1

*shui, - water -
A,10,["WATER",standard,R=0,A=0,S=1,X=0.5,Y=-0.5],-6

*weidingjie,___ _ ___
A,4.5,-1,1.5,-1

*hot, - hot -
A,8,[HOT,C:\Users\sheld\Desktop\housework\shape for lines.shx],-2,8,["HOT",standard,R=0,A=0,S=1,X=0.5,Y=-0.5],-4,8,[HOT,C:\Users\sheld\Desktop\housework\shape for lines.shx],-2,8

*shilong
A,0,[SHILEI,C:\Users\sheld\Desktop\housework\shape for lines.shx],-2

*shui2
A,10,[CIRCLE,C:\Users\sheld\Desktop\housework\shape for lines.shx],-1

*doubleline2,=(简陋版)
A,0,[DOUBLELINE,C:\Users\sheld\Desktop\housework\shape for lines.shx,Y=1],-1

*tiesiwang, - X -(简陋版)
A,8,["X",standard,R=0,A=0,S=1,X=0.5,Y=-0.5],-2

*zhalan, - + -(简陋版)
A,8,["+",standard,R=0,A=0,S=1,X=0.5,Y=-0.5],-2

shape for lines

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
*1,17,SHILEI
3,10,
1,
09,12,8,8,-8,-8,-8,-12,8,0,0
4,10,
0

*2,9,CIRCLE
3,2,1,0A,1,040,4,2,0

*3,21,HOT
1,09,
0,1,
2,0,
0,-2,
-2,0,
0,2,
2,-2,
-2,0,
2,2,
0,0,
0

*4,9,DOUBLELINE
2,014,
1,010,
2,02C,
1,018,
0

DAY3 .pat files

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
*HD
0,0,0,10,10,2.5,-17.5
90,0.6,0,10,10,1.3,-18.7
90,1.9,0,10,10,1.3,-18.7

*SNT
0,0.1,0.1,1.5,1.5,0,-1.5
0,0,0,3.0,1.5,3,-3

*ST
0,0,0,10,10,1,-19
90,0,0,10,10,2.5,-17.5

*TC
90,0,0,0,20,3.6,-17
90,1.2,0,0,20,3.6,-17
90,10,10,0,20,3.6,-17
90,11.2,10,0,20,3.6,-17

*XIAN
90,0,0,0,20,3.6,-17
90,1.2,0,0,20,3.6,-17
90,2.4,0,0,20,3.6,-17
90,10,10,0,20,3.6,-17
90,11.2,10,0,20,3.6,-17
90,12.4,10,0,20,3.6,-17

*YJD
90,0,0,0,40,3.6,-17
90,1.2,0.6,0,40,3.6,-17
90,2.4,1.2,0,40,3.6,-17
90,10,10,0,40,3.6,-17
90,11.2,10.6,0,40,3.6,-17
90,12.4,11.2,0,40,3.6,-17
90,20,1.2,0,40,3.6,-17
90,21.2,0.6,0,40,3.6,-17
90,22.4,0,0,40,3.6,-17
90,30,11.2,0,40,3.6,-17
90,31.2,10.6,0,40,3.6,-17
90,32.4,10,0,40,3.6,-17

*YND
0,0,0,3.0,1.5,3,-3

DAY4-DAY6 VLISP

2.1数据转换程序
1,X,Y,H or 1,X Y H -> 1 Y X H

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
(defun c:sjzh()
  (setq ff (open(getfiled "请选择需转换数据文件:" "" "txt" 2) "r")) ;getfiled  读取模式
  (setq rr (open "c:\\Users\\sheld\\Desktop\\housework\\vlisp\\data\\zhjg.txt" "w")) ;写入模式
  ;;;
  ;;;;;
  (while (setq zb (read-line ff))               ;循环条件

    (progn
    (while(vl-string-search "," zb)            ;vl-string-search;在一个字符串中搜寻特定模式
      (setq zb (vl-string-subst " " "," zb))   ;v1-string-subset;在一个字符串中，用一个字符串替代另一个字符串
    )                                          ;用空格代替逗号
    (setq zb (read(strcat "(" zb ")")))         ;strcat 字符串合并
    (setq n1  (vl-princ-to-string(nth 0 zb)))          ; nth 读取表中的第i+1个元素（从0开始） 1指第二个元素
    (setq n2  (vl-princ-to-string(nth 2 zb)))    ;last 获取最后一个元素 vl-price-to-string;返回LISP数据的字符串代表，
    (setq n3  (vl-princ-to-string(nth 1 zb)))
    (setq n4  (vl-princ-to-string(nth 3 zb)))
    (setq zb (strcat n1 " " n2 " " n3 " " n4))   ;调换顺序
    (write-line zb  rr) ;按行写入文本文件
    )
  )
  (close rr)              ;关闭流
  (close ff)
  )
  

2.2创建图层程序

(defun c:xjtc()
(entmake (list '(0 . "LAYER")    ;entmake创建实体，0：实体类型
(100 . "AcDbSymbolTableRecord")    ;子类标记
(100 . "AcDbLayerTableRecord")    ;子类标记
(70 . 0)        ;70:可见
(6 . "Continuous")     ;6:线型
(62 . 7)	;62:颜色
(370 . 0)	;370：线宽
(cons 2 "new layer")))	;2：图层名
  )

2.3展点程序
点号与点，高程分层

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
(defun c:kszd2()
(vl-load com) ;加载支持函数
(setq acadObject   (vlax-get-acad-object)) ;建立连接
(setq acadDocument (vla-get-ActiveDocument  acadObject))
(setq mySpace      (vla-get-ModelSpace      acadDocument))
(setq Layer-pt-Ele "高程注记"
      Layer-pt-Sn  "点号注记"
      Layer-pt     "展点"
)
(if (=(tblsearch  "layer" Layer-pt-Ele)nil)
    (command "layer" "n" Layer-pt-Ele ""))
(if (=(tblsearch  "layer" Layer-pt-Sn)nil)
    (command "layer" "n" Layer-pt-Sn ""))
(if (=(tblsearch  "layer" Layer-pt)nil)
    (command "layer" "n" Layer-pt ""))
(setvar "cmdecho" 0)
(setvar "osmode"  0)
(setvar "clayer"  Layer-pt)
(setq  Pt-list nil)
(setq  F-coordinates (open(getfiled "请选择数据文件:" "" "txt" 2)"r"))
(while (setq Info-Line(read-line F-coordinates))
  
	    (while(vl-string-search "," Info-Line)
	      (setq Info-Line(vl-string-subst " " "," Info-Line)))

              (setq Info-Line (read (strcat "("Info-Line ")"))

		    pt-sigle  (list
				(nth 2 Info-Line)
				(nth 1 Info-Line)
				(nth 3 Info-Line))
		    sn  (vl-princ-to-string (car Info-Line))
		    ele (vl-princ-to-string (last Info-Line))
		    pt-list(append pt-list(list(list pt-sigle sn ele)))
		)
	      )
(close F-coordinates)
(setq Pt-sort (vl-sort Pt-list
		  '(lambda (e1 e2)
		     (< (car (car e1))
			(car (car e2)))))
          x0 (car (car (car Pt-sort)))
          x1 (car (car (last Pt-sort)))
          Pt-sort (vl-sort Pt-list
		      '(lambda (e1 e2)
			 (< (cadr (car e1))
			    (cadr (car e2))
			    )
			 )
		      )
          y0 (cadr (car (car Pt-sort)))
          y1 (cadr (car (last Pt-sort)))
    )
(command "zoom" "w"(list x0 y0) (list x1 y1))

(setq note-ele-set (ssadd)
      note-sn-set  (ssadd))
(foreach pt-every Pt-list
  (setq pt1(car pt-every)  ;坐标点
	pt2(mapcar '+ pt1 '( 1.5  -1.25  0.0))  ;高程注记位置
	pt3(mapcar '+ pt1 '(-5.5  -1.25  0.0))  ;点号注记位置
  )
  (setq note-ele (last pt-every)
	note-sn  (cadr pt-every)
  )
  (setq pt1-obj (vlax-3d-point pt1)
	pt2-obj (vlax-3d-point pt2)
	pt3-obj (vlax-3d-point pt3)
	)
  (vla-AddPoint mySpace  pt1-obj)
  (vla-Addtext  mySpace  note-ele pt2-obj 3)
  (ssadd (entlast) note-ele-set)
  (vla-Addtext  mySpace  note-sn  pt3-obj 3)
  (ssadd (entlast) note-sn-set)
  )
		

  (command "select" note-ele-set "")
(setq ss-ele (vla-get-ActiveSelecrtionSet acadDocument))
(vlax-for ele-every ss-ele (vla-put-layer ele-every Layer-Pt-Ele))

(command "select" note-sn-set "")
(setq ss-sn (vla-get-ActiveSelecrtionSet acadDocument))
(vlax-for sn-every ss-sn (vla-put-layer sn-every Layer-Pt-Sn))
(princ)
)

2.4陡坎绘制程序

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
(defun dk_single() ;定义函数 无参数 绘制单条陡坎
  (setq distance_line (distance first_p end_p)); 赋值函数 例如 setq a 3
  (setq repeat_time (fix (/ distance_line 4))) ;设置重复次数

  (setq angle_line (angle first_p end_p))
  (setq angle_vertical (+ angle_line (/ (* fx pi) 2.0)))
  (command "line" first_p end_p ""); 画直线
  (setq pt1 first_p)
  (repeat repeat_time
    (setq pt2 (polar pt1 angle_vertical 5.0)) ;极坐标获取点坐标
    (setq pt3 (polar pt1 angle_line 2.0))
    (setq pt4 (polar pt3 angle_vertical 1.0))
    (command "line" pt1 pt2 "")
    (command "line" pt3 pt4 "")
    (setq pt1 (polar pt3 angle_line 2.0))
    )
  (setq pt1 (polar first_p angle_line (* repeat_time 4.0))) ;
  (setq distance_rest (distance pt1 end_p))
  (setq pt2 (polar pt1 angle_vertical 5.0))
  (command "line" pt1 pt2 "")
  (if
    (= (fix (/ distance_rest 2)) 1)
       (progn 
	(setq pt3 (polar pt1 angle_line 2.0))
    	(setq pt4 (polar pt3 angle_vertical 1.0))
    	(command "line" pt3 pt4 "")
	(command "line" pt1 end_p "")
	)
    (command "line" pt1 end_p "")
   )
  )

(defun c:hzdk()
  (setq old_os (getvar "osmode"))
  (setvar "osmode" 0)
  
  (setvar "Limmin" '(0.0 0.0))
  (setvar "Limmax" '(420.0 297.0))
  (command "zoom" "all")

  (setq first_p (getpoint "\n enter a point"))
  (setq end_p (getpoint first_p "\n enter a point"))
  (initget "Left Right")
  (setq side (getkword "\n choose the side of DP(Left or Right)<Left>"))
  (if
   (= side "Right")
   	(setq fx -1.0)
   (setq fx 1.0)
   )

  (while end_p ;点存在
    (progn ;语句组
      (dk_single)
      (setq first_p end_p)
      (setq end_p (getpoint first_p "\n enter a point"))
      )
    
    )

  (command "line" pt1 pt2 "")
  (setvar "osmode" old_os)
  )

2.5旱地绘制程序

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
(defun c:tchd()
  (setq os (getvar "osmode")
	cm (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setvar "osmode" 33)
 (command "_undo" "be")
 (if (setq p1 (getpoint "\n指定第一点p1:"))
 (if (setq p2 (getpoint p1 "\n指定第二点p2:"))
 (progn
 (if (setq r (distance p1 p2 ))
 (progn
 (setvar "osmode" 33)
 (command "circle" p1 r)
 (command "_hatch""HD" entlast "0")
 (command "_chprop" (entlast) "" "c" 1 ""))
 ))
 )
 )
 (command "_undo" "e")
 (setvar "cmdecho" cm)
 (setvar "osmode" os)(princ)
 )

2.6绘制平行线程序

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
(defun c:hxpxx()
(vl-load-com)  ;; load ActiveX support fuction
(setq MY_ModelSpace	(vla-get-Modelspace (vla-get-activedocument (vlax-get-acad-object)))) ;当下 模型控件对象-文档对象-acad
;;
(setq first_p (getpoint "\n input a point:"))
(setq second_p (getpoint first_p "\n input the second point:"))
(setq list_p (list (car first_p) (cadr first_p) 0.0
	(car second_p) (cadr second_p) 0.0))
;;
(setq POINTS (vlax-make-safearray vlax-vbdouble '(0 . 5))) ;;安全数组，double
(vlax-safearray-fill POINTS list_p)
(setq PlineObject (vla-addpolyline MY_ModelSpace POINTS)) ;;多段线
;;
(setq next_p (getpoint second_p "\n input the next point(enter for end):"))
(while next_p
	(progn
		(setq next_p_Objext (vlax-3d-point next_p))
		(vla-AppendVertex PlineObject next_p_Objext) ;添加
		(setq next_p (getpoint next_p "\n input the next point(enter for end):"))
		))
;;
;;(alert "attention: use + or - to represent width")
(setq width (getreal "\n input the width of the line \n attention: use + or - to represent width :"))
;;
(initget "Y N")  ;输入
(setq CurveFitting (getkword "\n fit the line? Y or N <N>"))
(if (= CurveFitting "Y")
	(progn
	(setq CF_Pline (entlast))  ;;返回最后一个未删除的对象
	(command "pedit" CF_Pline "S" "" "")
	))	
;;
(setq Offset_Object (vla-offset PlineObject width))
;;(command "ofset" width CF_Pline (getponit) "")
(vla-zoomall vlax-get-acad-object)
)

三点画房程序
按照照点号的连接顺序 设置误差阈值 点位误差距离大于精度要求 判断长边 绘制矩形

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
(defun c:sdhf()
  (setq old_os (getvar "osmode"))                         
  (setvar "osmode" 0)                                    
  (setvar "limmin" '(0.0 0.0))                            
  (setvar "limmax" '(420.0 297.0))                        
  (command "zoom" "all")
  (setq first_p (getpoint "\n enter a point"))
  (setq second_p   (getpoint first_p "\n enter a point"))
    (command "line" first_p second_p "" )
  (setq third_p   (getpoint second_p "\n enter a point"))
  (setq d1 (distance first_p second_p))             
  (setq d2 (distance third_p second_p))
  (if (> d1 d2)
    (progn
      (setq cb d1)
      (setq db d2)
      (setq pt1 first_p)            ;将第一、第二、第三个点重新排序
      (setq pt2 second_p)
      (setq pt3 third_p)
      )
    )
  (if (> d2 d1)
    (progn
      (setq cb d2)
      (setq db d1)
      (setq pt1 third_p)
      (setq pt2 second_p)
      (setq pt3 first_p)
      )
    )
  (if (= d2 d1)
    (progn
      (setq cb d2)
      (setq db d1)
      (setq pt1 third_p)
      (setq pt2 second_p)
      (setq pt3 first_p)
      )
    )
  (command "erase" "f" first_p second_p "" "")
 
  (setq xc (* db 0.1))
  (setq pd (* db 1.4))
  (setq j1 (angle pt1 pt2))
  (setq j2 (+ j1 (/ pi 2.0)))
  (setq j3 (+ j2  pi ))
  (setq pt4 (polar pt2 j2 db))
  (setq pt5 (polar pt2 j3 db))
  (setq d3 (distance pt5 pt3))
  (if(> d3 pd)
    (progn
      (setq pt6 pt4)
      (setq j4 j2)
      )
    )
  (if(< d3 pd)
    (progn
      (setq pt6 pt5)
      (setq j4 j3)
      )
    )
  (setq d4(distance pt3 pt6))
  (if(> d4 xc)
    (alert "超限，请重画!"))
  (if(< d4 xc)
    (progn
      (setq pt7 (polar pt1 j4 db ))
         (command "line" pt1 pt2 "")
         (command "line" pt6 pt7 "")
         (command "line" pt2 pt6 "")
         (command "line" pt1 pt7 "")
      )
)
)