求程序：等高线高程值取整

xuexicad1960

前几天发过类似的一个贴，可能没把问题说清，帖子一直没人回答，在此再说明一下，地形图中的等高线根据需要做了move + rotate + scale 的动作后，图中所有的高程值都发生了变化，等高线出现了小数位。  如：1048.012    1045.965 ，按道理这些都应该是整米数。我请高手们帮我解决这个困扰我多时的问题。我的想法是这样的，利用取整函数 fix  或 round 取整。为了更好说明问题附上一份问题样图。   这里的高手不少，希望能帮我解决，期待中。。。。。。

song宋_74729

461045462 发表于 2011-2-9 23:01
我将样图的高程值改了后，放在同事的电脑上，cass8.0下运行也是不行，不知是为什么？
我现在将改了的样图 ...

;;自己加个循环吧
(vl-load-com)
(defun c:tt ()
  (princ "功能：等高线高程值取整")
  (setq ss (ssget))
  (setq ent (ssname ss 0))
  (setq obj (vlax-ename->vla-object ent))
  (setq zgc (itoa (fix (vla-get-Elevation obj))))
  (setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for obj ssv (vlax-put obj 'Elevation zgc))
  (princ)
)

;这个好像可以了。
(defun c:tt6 ()
  (princ "功能：等高线高程值取整")
  (setq ss (ssget "X" (list (cons 8 "dgx") (cons 0 "LWPOLYLINE"))))
  ;(setq ss (ssget))
  (if ss
    (progn
      (setq ss4 (sslength ss))
      (setq n 0)
      (while (/= ss4 n)
             (setq en (ssname ss n))
             (setq end (entget en))
             (setq a (cdr (assoc 38 end)) adata end)
             (setq b (rtos a 2 0))
             (setq adata (subst (cons 38 (atoi b)) (assoc 38 adata) adata))
             (entmod adata)
             (setq n (+ n 1))
      )
    )
  )
  (princ)
)


改成这样TT也可以,TT6也可以

gzxl

;;;自己加个循环吧

(defun c:tt ()
  (princ "功能：等高线高程值取整")
  (setq ss (ssget))
  (setq ent (ssname ss 0))
  (setq obj (vlax-ename->vla-object ent))
  (setq zgc (itoa (fix (vla-get-Elevation obj))))
  (setq ssv (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object))))
  (vlax-for obj ssv (vlax-put obj 'Elevation zgc))
  (princ)
)

xuexicad1960

我对编程不懂，对lsp语言一知半解，循环语句我没加上，就试着加载运行了一下，提示; 错误 ：no function definition: VLAX-ENAME->VLA-OBJECT，我在程序的开头加了一句(vl-load-com) 后就能运行了，由于循环没有加，单选一根线结果是对的，多选就不对了，同时我发现都是截掉尾数取整了，如果我的图中还有需要进位取整的线，比如：1045.965 、1043.892又该如何呢，我的等高距是2米的，请你再帮我解决一下。谢谢了！！！！！！

gzxl

^_^ 我也是对编程不懂，对lsp语言也是一知半解,我试试再弄下 ^_^

gzxl

要进位就把这句 (setq zgc (itoa (fix (vla-get-Elevation obj))))改成
(setq zgc (rtos (vla-get-Elevation obj) 2 0))

xuexicad1960

回复 gzxl 的帖子

改了这句后，进位的问题解决了，现在就剩循环的问题了，我再学习学习看能否自己完成。这个程序以后还会用到。再次感谢你帮我。祝你春节快乐！新的一年里事业蒸蒸日上。

sy100

可以换个思路，将等高线Z值重新赋值，记得有个插件能够批量赋值的

xuexicad1960

批量赋值我这里有，如果这个不行，也只好重新赋值了，但是我还是不死心，那位朋友已经帮了我很多，谢谢各位。

461045462

在网络上曾经看见过有关类似的问题。
Int ( [elev]*10+0.5 )/10
进行四舍五入的编辑。
有一个有关小数点位数修改的程序从网上转给你参考：谢谢原作者
(defun c:tt ( / dcm dcm1 dcm2 dcm3 dcmdata ent2 ii itg itg1 itg2 itgdata ss ss1 ss2 ss3)
  (princ "功能：水深点小数点2位变1位")
  (setq ss (ssget ()))
  (setq ss1 (sslength ss))   ;ss1个数
  (setq ii 0)
  (repeat ss1
    (setq ss2 (ssname ss ii)) ;ss2图元名
    (setq ss3 (entget ss2))   ;ss3属性
    (setq ent2 ss3)
    (if (= (cdr (assoc 0 (setq ent2 (entget (entnext (cdr (assoc -1 ent2)))))))
            "ATTRIB"
        )
        (if (= (cdr (assoc 2 ent2)) "integer")
            (setq itg (cdr (assoc 1 ent2))
                  itgdata ent2
            )
        )
    )
    (if (= (cdr (assoc 0 (setq ent2 (entget (entnext (cdr (assoc -1 ent2)))))))
           "ATTRIB"
        )
        (if (= (cdr (assoc 2 ent2)) "decimal")
            (setq dcm (cdr (assoc 1 ent2))
                  dcmdata ent2
            )
        )
    )
    (setq dcm1 (atoi dcm))
    (if (/= "10" dcm2)
        (progn
           (setq dcm2 (rtos (* dcm1 0.1) 2 0)
                 dcm3 (cons 1 (strcat (itoa (atoi dcm2))))
                 dcmdata (subst dcm3 (assoc 1 dcmdata) dcmdata)
           )
           (entmod dcmdata)
        )
    )
    (if (= "10" dcm2)
        (progn
           (setq dcm1 0)
           (setq dcm2 (cons 1 (strcat (itoa dcm1))))
           (setq dcmdata (subst dcm2 (assoc 1 dcmdata) dcmdata))
           (setq itg1 (atoi itg))
           (setq itg2 (cons 1 (strcat (itoa (+ 1 itg1)))))
           (setq itgdata (subst itg2 (assoc 1 itgdata) itgdata))
           (entmod dcmdata)
           (entmod itgdata)
        )
    )
    (entmod dcmdata)
    (setq ii (1+ ii))
    (entupd ss2)
  )
  (princ)
)
祝你早点解决

gzxl

这个好像可以了。
(defun c:tt ()
  (princ "功能：等高线高程值取整")
  (setq ss (ssget "X" (list (cons 8 "dgx") (cons 0 "LWPOLYLINE"))))
  ;(setq ss (ssget))
  (if ss
    (progn
      (setq ss4 (sslength ss))
      (setq n 0)
      (while (/= ss4 n)
             (setq en (ssname ss n))
             (setq end (entget en))
             (setq a (cdr (assoc 38 end)) adata end)
             (setq b (rtos a 2 0))
             (setq adata (subst (cons 38 (atoi b)) (assoc 38 adata) adata))
             (entmod adata)
             (setq n (+ n 1))
      )
    )
  )
  (princ)
)