szx025 发表于 2016-9-26 14:18:38

标高标注程序

;;取两点Y坐标差通用函数
(defun szx_h (a b)
(setq h (abs (- (cadr a) (cadr b))))
(atof (rtos h 2 3))
)

(defun c:tt (/ pt1 pt2 old_cmd cl ortho ww hh1 ang pt3 hh hh2 str bg)
;;保存系统变量设置
(setq old_CMD (getvar "CMDECHO")) ;_取得变量值
(setq cl (getvar "clayer"))
(setvar "CMDECHO" 0)
(setq ortho (getvar "orthomode")) ;_取得变量值
(setvar "orthomode" 0) ;_关
(setq ww (getvar "dimzin"))
(setvar "dimzin" 1)
(if (not (tblsearch "layer" "标高"))
    (command "-layer" "m" "标高" "c" "3" "" "")
)
(setvar "clayer" "标高")
(setq pt1 (getpoint "\n标高基准点:"))
(if (not (setq hh1 (getreal "\n请输入基准点标高±0.000:")))
    (setq hh1 0.000)
)
(setqhh1 (if(/= hh1 0)
      (rtos hh1 2 3)
      "%%P0.000"
      )
)
(while (setq pt2 (getpoint pt1 "\n定位点:"))
    (setq ang (angle pt1 pt2))
    (setq pt3 (polar pt2 0 100))
    (setq hh(szx_h pt1 pt2)
    hh2 (/ hh 1000)
    )
    (if(/= (type hh1) 'str)
      (setq hh1 (vl-princ-to-string hh1))
    )          ;判断是否是字符串并转换
    (setq hh1 (atof hh1))    ;字符串转换成实型数
    (if(and (> ang 0) (< ang 3.141))
      (setq str (+ hh1 hh2))
      (setq str (- hh1 hh2))
    )
    (setq str (if (/= str 0)
    (rtos str 2 3)
    "%%P0.000"
      )
    )
    (if(and (> ang 1.570) (< ang 4.712))
      (command "._insert" "bgz.dwg" "non" pt2 "" "" str)
      (command "._insert" "bgy.dwg" "non" pt2 "" "" str)
    )
    (setq bg (entlast))
    (initget "Yes No")
    (if(= "Yes"
   (getkword "\n是否镜像？[是(Y)/否(N)] <N>:")
)
      (command "mirror" bg "" "non" pt2 "non" pt3 "y")
    )
    (setvar "orthomode" 1) ;_开   
    (command "_move" bg "" pt2 pause)
(setvar "orthomode" 0);_关
)
;;刷新图形窗口
(redraw)
(setvar "CMDECHO" old_CMD)
(setvar "orthomode" ortho) ;_恢复变量
(setvar "dimzin" ww)
(setvar "clayer" cl)
(princ)
)
网上找的标高标注程序，用起来都不顺手，自己写了一个，有需要的来去用

persuing 发表于 2016-9-28 12:55:46

代码写块操作，节选我的一段（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 发表于 2016-9-27 12:56:13

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

这文件怎么会这么大？

szx025 发表于 2016-9-26 14:20:43

图片放上来

start4444 发表于 2016-9-26 20:13:17

谢谢分享

迷不知途 发表于 2016-9-26 23:30:14

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

hao3ren 发表于 2016-9-27 00:58:47

块文件最好能写到程序里

szx025 发表于 2016-9-27 08:28:51

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

海贼凌源 发表于 2016-9-27 09:18:23

谢谢楼主，感觉很有用。

longer1000 发表于 2016-9-27 10:30:46

谢谢楼主，感觉很有用。

shh1980 发表于 2016-9-27 14:00:40

感谢楼主分享！
页: [1] 2
查看完整版本: 标高标注程序