计曲线标注程序

493514506

求等高线计曲线标注程序
要求：1，提示输入等高距： 米（如0.5 1 2 2.5等）
          2，画直线，创建所有与直线相交的DGX的选择集
          3，标注，获取选择集中每根等高线的标高，判断是否能够被（等高距与5的乘积）整除，若能整除，在等高线与直线的交点处标出等高线的标高（与直线垂直，字头朝向高处）
        4，删除直线。
附样图

byghbcx

试试这个，字头朝高处，自己加一个判断

2. (defun c:tt()
   
3.     (setq d (getreal "\n请输入等高距:") n 0)
   
4.     (setq pt1 (getpoint "\n请输入第一点:"))
   
5.     (setq pt2 (getpoint pt1 "\n请输入第二点:"))
   
6.     (command "_.line" pt1 pt2 "")
   
7.     (setq line (entlast))
   
8.     (setq ss (ssget "f" (list pt1 pt2) '((8 . "dgx"))))
   
9.     (if ss
   
10.       (repeat (sslength ss)
    
11.         (setq en (ssname ss n))
    
12.         (setq h (vla-get-elevation (vlax-ename->vla-object en)))
    
13.         (if (= (rem h (* d 5.0)) 0)
    
14.           (progn
    
15.         (setq dxf_line (entget line))
    
16.         (setq st (cdr (assoc 10 dxf_line)) et (cdr (assoc 11 dxf_line)))
    
17.         (setq st (list (car st) (cadr st) h) et (list (car et) (cadr et) h))
    
18.         (setq dxf_line (subst (cons 10 st) (assoc 10 dxf_line) dxf_line))
    
19.         (setq dxf_line (subst (cons 11 et) (assoc 11 dxf_line) dxf_line))
    
20.         (entmod dxf_line)
    
21.         (entupd line)
    
22.         (setq pt (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object line) (vlax-ename->vla-object en) acExtendNone))))
    
23.         (setq pt (list (car pt) (cadr pt)))
    
24.         (setq ang (/ (* 180 (vla-get-angle (vlax-ename->vla-object line))) pi))
    
25.         (command "_.text" pt 1 (+ ang 90) (rtos h 2 2))
    
26.           )
    
27.         )
    
28.         (setq n (1+ n))
    
29.       )
    
30.     )
    
31.     (command "_.erase" line "")
    
32.     (princ)
    
33.     )

(defun c:tt()<br />     (setq d (getreal "\n请输入等高距:") n 0)<br />     (setq pt1 (getpoint "\n请输入第一点:"))<br />     (setq pt2 (getpoint pt1 "\n请输入第二点:"))<br />     (command "_.line" pt1 pt2 "")<br />     (setq line (entlast))<br />     (setq ss (ssget "f" (list pt1 pt2) '((8 . "dgx"))))<br />     (if ss<br />       (repeat (sslength ss)<br />         (setq en (ssname ss n))<br />         (setq h (vla-get-elevation (vlax-ename->vla-object en)))<br />         (if (= (rem h (* d 5.0)) 0)<br />           (progn<br />         (setq dxf_line (entget line))<br />         (setq st (cdr (assoc 10 dxf_line)) et (cdr (assoc 11 dxf_line)))<br />         (setq st (list (car st) (cadr st) h) et (list (car et) (cadr et) h))<br />         (setq dxf_line (subst (cons 10 st) (assoc 10 dxf_line) dxf_line))<br />         (setq dxf_line (subst (cons 11 et) (assoc 11 dxf_line) dxf_line))<br />         (entmod dxf_line)<br />         (entupd line)<br />         (setq pt (vlax-safearray->list (vlax-variant-value (vla-IntersectWith (vlax-ename->vla-object line) (vlax-ename->vla-object en) acExtendNone))))<br />         (setq pt (list (car pt) (cadr pt)))<br />         (setq ang (/ (* 180 (vla-get-angle (vlax-ename->vla-object line))) pi))<br />         (command "_.text" pt 1 (+ ang 90) (rtos h 2 2))<br />           )<br />         )<br />         (setq n (1+ n))<br />       )<br />     )<br />     (command "_.erase" line "")<br />     (princ)<br />     )

425017842

CASS中有此功能，不过最多一次只能标注4根计曲线。

byghbcx

每根等高线的标高从哪获取？

493514506

多谢byghbcx ，可是程序只标注一根，其他满足条件的不标注，不知什么原因

byghbcx

493514506 发表于 2012-1-6 12:32
多谢byghbcx ，可是程序只标注一根，其他满足条件的不标注，不知什么原因

判断是否能够被（等高距与5的乘积）整除，我机上怎么是可以标注的？

493514506

少了两句
(vl-load-com)
(setq n 0)
基本可以实现，多谢帮助。程序根据需要完善中，完善后发上来。