在样本多段线中心标注高程

树櫴希德

2. 
   
3. ;;;by Gu_xl
   
4. (defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)
   
5. (vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP
   
6.   (regapp "SOUTH")
   
7.   (setvar "CMDECHO" 0)
   
8.   (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")
   
9.   (if height
   
10.     (setq height (rtos height 2 3));3为高程注记位数
    
11.     (setq height "")
    
12.   )
    
13.   (regapp "SOUTH")
    
14.   
    
15.   ;;;检查字体 "HZ" 是否存在
    
16.   (if (not (tblobjname "style" "宋体"))
    
17.     ;(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")
    
18.     (command "style" "宋体" "" 0 1 0 "" "" "")
    
19.   )
    
20.   ;;;检查是否存在高程点图块定义
    
21.   (if (not (tblobjname "block" "GC200"))
    
22.     (progn
    
23.       (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))
    
24.       (setq obj
    
25.         (vla-AddPolyline
    
26.            blkdef
    
27.            (vlax-make-variant
    
28.               (vlax-safearray-fill
    
29.                  (vlax-make-safearray vlax-vbdouble (cons 0 5))
    
30.                  '(-0.2 0 0 0.2 0 0)
    
31.               )
    
32.            )
    
33.         )
    
34.       )
    
35.       (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)
    
36.       (vla-put-Closed obj :vlax-true)
    
37.       (vla-put-ConstantWidth obj 0.4)
    
38.     )
    
39.   )
    
40.   ;;;插入块
    
41.   (entmake (list
    
42.              '(0 . "INSERT")
    
43.              '(100 . "AcDbEntity")
    
44.              '(100 . "AcDbBlockReference")
    
45.              '(66 . 1);;;属性跟随标志,1跟随，0不跟随
    
46.               (cons 2 "GC200")
    
47.               (cons 10 inspt)
    
48.               (cons 41 scale)
    
49.               (cons 42 scale)
    
50.               (cons 43 scale)
    
51.               (list -3 '("SOUTH" (1000 . "202101")))
    
52.            )
    
53.   )
    
54.   ;;;插入属性
    
55.   (entmake (list
    
56.              '(0 . "ATTRIB")
    
57.              '(100 . "AcDbEntity")
    
58.              '(100 . "AcDbText")
    
59.               (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))
    
60.               (cons 40 (* 2.0 scale))
    
61.               (cons 50 0)
    
62.               (cons 41 0.8)
    
63.               (cons 51 0)
    
64.               (cons 1 height)
    
65.               (cons 7 "宋体")
    
66.        (cons 62 3)
    
67.               (cons 72 0)
    
68.               (cons 11 pt)
    
69.               '(100 . "AcDbAttribute")
    
70.               (cons 2 "height")
    
71.               (cons 70  0)
    
72.               (cons 74 2)
    
73.            )
    
74.    )
    
75.    ;;;结束标志
    
76.    (entmake '((0 . "SEQEND")))
    
77.    (princ)
    
78. )
    
79. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
80. (defun vxs (e / i v lst)
    
81.   (setq i 0)
    
82.   (while
    
83.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
    
84.      (setq lst (cons v lst))
    
85.   )
    
86.   (reverse lst))
    
87. ;;;;;;;;;;;;;;;;;;;;;;;;
    
88. (defun zxd (ent / pts len pt )
    
89. (setq pts (vxs ent))
    
90.   (setq len (length pts))
    
91. (setq pt (mapcar
    
92.   '(lambda(x)
    
93.     (/ x len)
    
94.   )
    
95.   (apply
    
96.     'mapcar
    
97.     (cons '+ pts)
    
98.   )
    
99.   )
    
100.       )
     
101.   pt
     
102.   )
     
103. 
     
104. (defun changdu (e / )
     
105.   (Vla-get-length (VLAX-ename->vla-object e))
     
106.   )
     
107. (defun changdu1 (e / )
     
108.   (vlax-curve-getDistAtParam (VLAX-ename->vla-object e) (vlax-curve-getEndParam (VLAX-ename->vla-object e)));取得曲线长度
     
109.   )
     
110. (defun c:ctgc (  / gcz  yangbenchang  blc scale lst ent xinzb)
     
111. 
     
112. (setq gcz (getreal "\n请输入需要注记的高程值："))
     
113. (setq yangbenchang (changdu1 (car (entsel "\n请选择样本承台LWPOLYLINE:"))))
     
114. 
     
115.   (setq blc (getint "\n请输入比例尺1:<500>"))
     
116.   (if (= blc nil)(setq blc 500))
     
117.   (setvar 'userr1 blc);设置比例尺
     
118. (setq scale (* 0.001 blc));缩放比例
     
119. (setq i 0)
     
120.   (setq lst (ssget '( (0 . "*polyline") (8 . "BASE,基础边")) ) )
     
121. 
     
122.   (repeat (sslength lst)
     
123.   (setq ent (ssname lst i))
     
124. (if (equal yangbenchang (changdu1 ent) 0.1)
     
125. (progn
     
126. (setq xinzb (list (car (zxd ent)) (cadr (zxd ent)) gcz )  )
     
127. (gxl-cs:gcd xinzb gcz scale)
     
128.   )
     
129.   )
     
130. 
     
131. (setq i (+ i 1))
     
132.   )
     
133. 
     
134. 
     
135. 
     
136.   )
     
137. 
     
138. 
     
139. 
     
140. 
     

<br /> ;;;by Gu_xl<br /> (defun gxl-cs:gcd (inspt height scale / pt blkdef obj);展高程点函数(inspt:插入点,heitht:高程值,scale:缩放比例,xsws:高程注记位数)<br /> (vl-load-com) ;将 Visual LISP 扩展功能加载到 AutoLISP<br />   (regapp "SOUTH")<br />   (setvar "CMDECHO" 0)<br />   (command "layer" "m" "GCD" "c" "1" "" "L" "CONTINUOUS" ""  "")<br />   (if height<br />     (setq height (rtos height 2 3));3为高程注记位数<br />     (setq height "")<br />   )<br />   (regapp "SOUTH")<br />   <br />   ;;;检查字体 "HZ" 是否存在<br />   (if (not (tblobjname "style" "宋体"))<br />     ;(command "style" "HZ" "rs.shx,hztxt.shx" 0 1 0 "" "" "")<br />     (command "style" "宋体" "" 0 1 0 "" "" "")<br />   )<br />   ;;;检查是否存在高程点图块定义<br />   (if (not (tblobjname "block" "GC200"))<br />     (progn<br />       (setq blkdef (vla-Add (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3D-point '(0 0 0)) "GC200"))<br />       (setq obj<br />         (vla-AddPolyline<br />            blkdef<br />            (vlax-make-variant<br />               (vlax-safearray-fill<br />                  (vlax-make-safearray vlax-vbdouble (cons 0 5))<br />                  '(-0.2 0 0 0.2 0 0)<br />               )<br />            )<br />         )<br />       )<br />       (vla-SetBulge obj 0 1) (vla-SetBulge obj 1 1)<br />       (vla-put-Closed obj :vlax-true)<br />       (vla-put-ConstantWidth obj 0.4)<br />     )<br />   )<br />   ;;;插入块<br />   (entmake (list<br />              '(0 . "INSERT")<br />              '(100 . "AcDbEntity")<br />              '(100 . "AcDbBlockReference")<br />              '(66 . 1);;;属性跟随标志,1跟随，0不跟随<br />               (cons 2 "GC200")<br />               (cons 10 inspt)<br />               (cons 41 scale)<br />               (cons 42 scale)<br />               (cons 43 scale)<br />               (list -3 '("SOUTH" (1000 . "202101")))<br />            )<br />   )<br />   ;;;插入属性<br />   (entmake (list<br />              '(0 . "ATTRIB")<br />              '(100 . "AcDbEntity")<br />              '(100 . "AcDbText")<br />               (cons 10 (setq pt (polar inspt 0 (* 1.2 scale))))<br />               (cons 40 (* 2.0 scale))<br />               (cons 50 0)<br />               (cons 41 0.8)<br />               (cons 51 0)<br />               (cons 1 height)<br />               (cons 7 "宋体")<br />        (cons 62 3)<br />               (cons 72 0)<br />               (cons 11 pt)<br />               '(100 . "AcDbAttribute")<br />               (cons 2 "height")<br />               (cons 70  0)<br />               (cons 74 2)<br />            )<br />    )<br />    ;;;结束标志<br />    (entmake '((0 . "SEQEND")))<br />    (princ)<br /> )<br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun vxs (e / i v lst)<br />   (setq i 0)<br />   (while<br />     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />      (setq lst (cons v lst))<br />   )<br />   (reverse lst))<br /> ;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun zxd (ent / pts len pt )<br /> (setq pts (vxs ent))<br />   (setq len (length pts))<br /> (setq pt (mapcar<br />   '(lambda(x)<br />     (/ x len)<br />   )<br />   (apply<br />     'mapcar<br />     (cons '+ pts)<br />   )<br />   )<br />       )<br />   pt<br />   )<br /> <br /> (defun changdu (e / )<br />   (Vla-get-length (VLAX-ename->vla-object e))<br />   )<br /> (defun changdu1 (e / )<br />   (vlax-curve-getDistAtParam (VLAX-ename->vla-object e) (vlax-curve-getEndParam (VLAX-ename->vla-object e)));取得曲线长度<br />   )<br /> (defun c:ctgc (  / gcz  yangbenchang  blc scale lst ent xinzb)<br /> <br /> (setq gcz (getreal "\n请输入需要注记的高程值："))<br /> (setq yangbenchang (changdu1 (car (entsel "\n请选择样本承台LWPOLYLINE:"))))<br /> <br />   (setq blc (getint "\n请输入比例尺1:<500>"))<br />   (if (= blc nil)(setq blc 500))<br />   (setvar 'userr1 blc);设置比例尺<br /> (setq scale (* 0.001 blc));缩放比例<br /> (setq i 0)<br />   (setq lst (ssget '( (0 . "*polyline") (8 . "BASE,基础边")) ) )<br /> <br />   (repeat (sslength lst)<br />   (setq ent (ssname lst i))<br /> (if (equal yangbenchang (changdu1 ent) 0.1)<br /> (progn<br /> (setq xinzb (list (car (zxd ent)) (cadr (zxd ent)) gcz )  )<br /> (gxl-cs:gcd xinzb gcz scale)<br />   )<br />   )<br /> <br /> (setq i (+ i 1))<br />   )<br /> <br /> <br /> <br />   )<br /> <br /> <br /> <br /> <br />

su0518

命令是多少呀？

88641787

如何使用   能不能演示一下