求程序：等高线高程值取整
前几天发过类似的一个贴，可能没把问题说清，帖子一直没人回答，在此再说明一下，地形图中的等高线根据需要做了move + rotate + scale 的动作后，图中所有的高程值都发生了变化，等高线出现了小数位。如：1048.012 1045.965 ，按道理这些都应该是整米数。我请高手们帮我解决这个困扰我多时的问题。我的想法是这样的，利用取整函数 fix或 round 取整。为了更好说明问题附上一份问题样图。 这里的高手不少，希望能帮我解决，期待中。。。。。。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也可以 ;;;自己加个循环吧
(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)
) 我对编程不懂，对lsp语言一知半解，循环语句我没加上，就试着加载运行了一下，提示; 错误 ：no function definition: VLAX-ENAME->VLA-OBJECT，我在程序的开头加了一句(vl-load-com) 后就能运行了，由于循环没有加，单选一根线结果是对的，多选就不对了，同时我发现都是截掉尾数取整了，如果我的图中还有需要进位取整的线，比如：1045.965 、1043.892又该如何呢，我的等高距是2米的，请你再帮我解决一下。谢谢了！！！！！！ ^_^ 我也是对编程不懂，对lsp语言也是一知半解,我试试再弄下 ^_^ 要进位就把这句 (setq zgc (itoa (fix (vla-get-Elevation obj))))改成
(setq zgc (rtos (vla-get-Elevation obj) 2 0)) 回复 gzxl 的帖子
改了这句后，进位的问题解决了，现在就剩循环的问题了，我再学习学习看能否自己完成。这个程序以后还会用到。再次感谢你帮我。祝你春节快乐！新的一年里事业蒸蒸日上。 可以换个思路，将等高线Z值重新赋值，记得有个插件能够批量赋值的 批量赋值我这里有，如果这个不行，也只好重新赋值了，但是我还是不死心，那位朋友已经帮了我很多，谢谢各位。 在网络上曾经看见过有关类似的问题。
Int ( *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)
)
祝你早点解决
这个好像可以了。
(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)
)
页:
[1]
2