标高标注程序

szx025

2. ;;取两点Y坐标差通用函数
   
3. (defun szx_h (a b)
   
4.   (setq h (abs (- (cadr a) (cadr b))))
   
5.   (atof (rtos h 2 3))
   
6. )
   
7. 
   
8. (defun c:tt (/ pt1 pt2 old_cmd cl ortho ww hh1 ang pt3 hh hh2 str bg)
   
9.   ;;保存系统变量设置
   
10.   (setq old_CMD (getvar "CMDECHO")) ;_取得变量值
    
11.   (setq cl (getvar "clayer"))
    
12.   (setvar "CMDECHO" 0)
    
13.   (setq ortho (getvar "orthomode")) ;_取得变量值
    
14.   (setvar "orthomode" 0) ;_关
    
15.   (setq ww (getvar "dimzin"))
    
16.   (setvar "dimzin" 1)
    
17.   (if (not (tblsearch "layer" "标高"))
    
18.     (command "-layer" "m" "标高" "c" "3" "" "")
    
19.   )
    
20.   (setvar "clayer" "标高")
    
21.   (setq pt1 (getpoint "\n标高基准点:"))
    
22.   (if (not (setq hh1 (getreal "\n请输入基准点标高±0.000:")))
    
23.     (setq hh1 0.000)
    
24.   )
    
25.   (setq  hh1 (if  (/= hh1 0)
    
26.         (rtos hh1 2 3)
    
27.         "%%P0.000"
    
28.       )
    
29.   )
    
30.   (while (setq pt2 (getpoint pt1 "\n定位点:"))
    
31.     (setq ang (angle pt1 pt2))
    
32.     (setq pt3 (polar pt2 0 100))
    
33.     (setq hh  (szx_h pt1 pt2)
    
34.     hh2 (/ hh 1000)
    
35.     )
    
36.     (if  (/= (type hh1) 'str)
    
37.       (setq hh1 (vl-princ-to-string hh1))
    
38.     )          ;判断是否是字符串并转换
    
39.     (setq hh1 (atof hh1))    ;字符串转换成实型数
    
40.     (if  (and (> ang 0) (< ang 3.141))
    
41.       (setq str (+ hh1 hh2))
    
42.       (setq str (- hh1 hh2))
    
43.     )
    
44.     (setq str (if (/= str 0)
    
45.     (rtos str 2 3)
    
46.     "%%P0.000"
    
47.         )
    
48.     )
    
49.     (if  (and (> ang 1.570) (< ang 4.712))
    
50.       (command "._insert" "bgz.dwg" "non" pt2 "" "" str)
    
51.       (command "._insert" "bgy.dwg" "non" pt2 "" "" str)
    
52.     )
    
53.     (setq bg (entlast))
    
54.     (initget "Yes No")
    
55.     (if  (= "Yes"
    
56.      (getkword "\n是否镜像？[是(Y)/否(N)] <N>:")
    
57.   )
    
58.       (command "mirror" bg "" "non" pt2 "non" pt3 "y")
    
59.     )
    
60.     (setvar "orthomode" 1) ;_开   
    
61.     (command "_move" bg "" pt2 pause)
    
62.   (setvar "orthomode" 0);_关
    
63.   )
    
64.   ;;刷新图形窗口
    
65.   (redraw)
    
66.   (setvar "CMDECHO" old_CMD)
    
67.   (setvar "orthomode" ortho) ;_恢复变量
    
68.   (setvar "dimzin" ww)
    
69.   (setvar "clayer" cl)
    
70.   (princ)
    
71. )
    

;;取两点Y坐标差通用函数<br /> (defun szx_h (a b)<br />   (setq h (abs (- (cadr a) (cadr b))))<br />   (atof (rtos h 2 3))<br /> )<br /> <br /> (defun c:tt (/ pt1 pt2 old_cmd cl ortho ww hh1 ang pt3 hh hh2 str bg)<br />   ;;保存系统变量设置 <br />   (setq old_CMD (getvar "CMDECHO")) ;_取得变量值<br />   (setq cl (getvar "clayer"))<br />   (setvar "CMDECHO" 0)<br />   (setq ortho (getvar "orthomode")) ;_取得变量值<br />   (setvar "orthomode" 0) ;_关<br />   (setq ww (getvar "dimzin"))<br />   (setvar "dimzin" 1)<br />   (if (not (tblsearch "layer" "标高"))<br />     (command "-layer" "m" "标高" "c" "3" "" "")<br />   )<br />   (setvar "clayer" "标高")<br />   (setq pt1 (getpoint "\n标高基准点:"))<br />   (if (not (setq hh1 (getreal "\n请输入基准点标高±0.000:")))<br />     (setq hh1 0.000)<br />   )<br />   (setq  hh1 (if  (/= hh1 0)<br />         (rtos hh1 2 3)<br />         "%%P0.000"<br />       )<br />   )<br />   (while (setq pt2 (getpoint pt1 "\n定位点:"))<br />     (setq ang (angle pt1 pt2))<br />     (setq pt3 (polar pt2 0 100))<br />     (setq hh  (szx_h pt1 pt2)<br />     hh2 (/ hh 1000)<br />     )<br />     (if  (/= (type hh1) 'str)<br />       (setq hh1 (vl-princ-to-string hh1))<br />     )          ;判断是否是字符串并转换<br />     (setq hh1 (atof hh1))    ;字符串转换成实型数<br />     (if  (and (> ang 0) (< ang 3.141))<br />       (setq str (+ hh1 hh2))<br />       (setq str (- hh1 hh2))<br />     )<br />     (setq str (if (/= str 0)<br />     (rtos str 2 3)<br />     "%%P0.000"<br />         )<br />     )<br />     (if  (and (> ang 1.570) (< ang 4.712))<br />       (command "._insert" "bgz.dwg" "non" pt2 "" "" str)<br />       (command "._insert" "bgy.dwg" "non" pt2 "" "" str)<br />     )<br />     (setq bg (entlast))<br />     (initget "Yes No")<br />     (if  (= "Yes"<br />      (getkword "\n是否镜像？[是(Y)/否(N)] <N>:")<br />   )<br />       (command "mirror" bg "" "non" pt2 "non" pt3 "y")<br />     )<br />     (setvar "orthomode" 1) ;_开    <br />     (command "_move" bg "" pt2 pause)<br />   (setvar "orthomode" 0);_关<br />   )<br />   ;;刷新图形窗口<br />   (redraw)<br />   (setvar "CMDECHO" old_CMD)<br />   (setvar "orthomode" ortho) ;_恢复变量<br />   (setvar "dimzin" ww)<br />   (setvar "clayer" cl)<br />   (princ)<br /> )<br />

网上找的标高标注程序，用起来都不顺手，自己写了一个，有需要的来去用

persuing

代码写块操作，节选我的一段（CASS高程点块），供楼主参考：
(setq hatchobj(vla-addhatch block achatchpatterntypepredefined  "solid" :vlax-true));创建填充样式
               (setq obj(vla-addcircle block (vlax-3d-point pt) 0.1));创建外环边界添加样式
               (setq outerloop(vlax-make-safearray vlax-vbobject '(0 . 0)));创建填充边界对象数组
               (vlax-safearray-fill outerloop (list obj));数组填充对象
               (vla-appendouterloop hatchobj outerloop)
               (vla-evaluate hatchobj)
               (vla-regen doc :vlax-true)

h008

szx025 发表于 2016-9-27 08:28
属性块忘了，补上另：如何把属性块放在程序中，请高手指点一下

这文件怎么会这么大？

szx025

图片放上来

start4444

谢谢分享

迷不知途

大师：bgz.dwg bgy.dwg能否发上来？多谢

hao3ren

块文件最好能写到程序里

szx025

属性块忘了，补上另：如何把属性块放在程序中，请高手指点一下

海贼凌源

谢谢楼主，感觉很有用。

longer1000

谢谢楼主，感觉很有用。

shh1980

感谢楼主分享！