[已解決]請問LISP有辦法做到把圖面上畫歪的小數點線段修成整數嗎?

最近接到一套圖被很多人修過又套來套去的
很多線段都畫歪，有許多0.0004、0.0001之類的小數點
經理每看到一次就唸一次
又不准我花時間去把圖重新放樣
請問lisp有辦法寫出讓小數點好幾位的線段端點，去抓最靠近的0.5格點嗎?
謝謝

;;2010-10-15 By PizG
(defun c:FixDwg(/ FixVal ssl i ent dxf p1 x1 y1 z1 p2 x2 y2 z2)
;;(FixVal (setq r 123.234)) RETURN 123.0
;;(FixVal (setq r 123.456)) RETURN 123.5
;;(FixVal (setq r 123.789)) RETURN 124.0
(defun FixVal(r / v)
(setq v (rem r 1))
(cond
((< v 0.25) (setq ret (- r v)))
((< v 0.75) (setq ret (+ (- r v) 0.5)))
(T (setq ret (+ (- r v) 1)))
)
)

;;
(if (setq ssl (ssget '((0 . "LINE"))))
(progn
(setq i 0)
(repeat (sslength ssl)
(setq ent (ssname ssl i))
(setq dxf (entget ent))
(setq p1 (cdr (assoc 10 dxf)))
(setq x1 (FixVal (nth 0 p1)))
(setq y1 (FixVal (nth 1 p1)))
(setq z1 (FixVal (nth 2 p1)))
(setq dxf (subst (cons 10 (list x1 y1 z1)) (assoc 10 dxf) dxf))
(setq p2 (cdr (assoc 11 dxf)))
(setq x2 (FixVal (nth 0 p2)))
(setq y2 (FixVal (nth 1 p2)))
(setq z2 (FixVal (nth 2 p2)))
(setq dxf (subst (cons 11 (list x2 y2 z2)) (assoc 11 dxf) dxf))
(entmod dxf)
(setq i (1+ i))
)
(alert "DONE!")
)
)
(princ)
)

天阿 真是太神奇了
真的很大的幫助，萬分感謝~~~~
但PLINE是不是無法選取到? 剛剛試了幾次都一樣QQ

franwist 寫到: 天阿 真是太神奇了
真的很大的幫助，萬分感謝~~~~
但PLINE是不是無法選取到? 剛剛試了幾次都一樣QQ

依照你的要求, 增加處理PLINE的功能, 程式碼如下所示,
若還有其它問題, 可以在此留言, 或發送短信給我.

;;By PizG
;;2010-10-16 增加處理PLINE
;;2010-10-15 處理LINE
(defun c:FixDwg (/ FixVal ssl i ent dxf typ p1 x1 y1 z1 p2 x2 y2 z2 lst j code)
 ;;(FixVal (setq r 123.234)) RETURN 123.0
 ;;(FixVal (setq r 123.456)) RETURN 123.5
 ;;(FixVal (setq r 123.789)) RETURN 124.0
 (defun FixVal (r / v)
   (setq v (rem r 1))
   (cond
     ((< v 0.25) (setq ret (- r v)))
     ((< v 0.75) (setq ret (+ (- r v) 0.5)))
     (T (setq ret (+ (- r v) 1)))
   )
 )

 ;;
 (if (setq ssl (ssget '((0 . "LINE,LWPOLYLINE"))))
   (progn
     (setq i 0)
     (repeat (sslength ssl)
(setq ent (ssname ssl i))
(setq dxf (entget ent))
(setq typ (cdr (assoc 0 dxf)))
(cond
 ((= typ "LINE")
   (setq p1 (cdr (assoc 10 dxf)))
   (setq x1 (FixVal (nth 0 p1)))
   (setq y1 (FixVal (nth 1 p1)))
   (setq z1 (FixVal (nth 2 p1)))
   (setq dxf (subst (cons 10 (list x1 y1 z1)) (assoc 10 dxf) dxf))
   (setq p2 (cdr (assoc 11 dxf)))
   (setq x2 (FixVal (nth 0 p2)))
   (setq y2 (FixVal (nth 1 p2)))
   (setq z2 (FixVal (nth 2 p2)))
   (setq dxf (subst (cons 11 (list x2 y2 z2)) (assoc 11 dxf) dxf))
 )
 ((= typ "LWPOLYLINE")
   (setq lst '() j 0)
   (repeat (length dxf)
     (setq code (nth j dxf))
     (if (= (car code) 10)
(progn
         (setq p1 (cdr code))
         (setq x1 (FixVal (nth 0 p1)))
         (setq y1 (FixVal (nth 1 p1)))
 (setq code (list 10 x1 y1))
)
     )
     (setq lst (cons code lst))
     (setq j (1+ j))
   )  
   (setq dxf (reverse lst))
 )
)  
(entmod dxf)
(setq i (1+ i))
     )
     (alert "DONE!")
   )
 )
 (princ)
)

---

Tiger&蘋果爸 寫到: 感恩您的無私分享<積分+1>

pizg大大實在是太熱心了
我真的很感動~QQ

franwist 寫到:pizg大大實在是太熱心了
我真的很感動~QQ

很高興你的問題已獲得幫助~
提醒你:
已解決主題顏色要改為[無]

我去年剛上班也遇過這種問題，所以寫了這個程式，使用前請先設定格線X間距GridUnit:0.5,0.5(這程式X,Y都用第一個當間距值，
如果要改成X,Y不等間距值的話再提出來討論吧，對Line很簡單，對聚合線就稍微麻煩了)
當時剛學CAD，lisp不熟所以副程式用中文變數請勿見笑，能用就好
--------------------------------------------------------------
(defun c:Fix(/ tor xen i cs)
(defun RoundUp(值 距)
(setq 正負(minusp 值)
餘數(rem(abs 值)距)
商數(-(abs 值)餘數)
結果(+(if(<=(* 0.5 距)餘數)距 0)商數))
(if 正負(- 結果)結果))
(defun LV(l)(vlax-make-variant(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble(cons 0(1-(length l))))l)))
(defun VL(v)(vlax-safearray->list(vlax-variant-value v)))
(defun fixPt(p f)(list(RoundUp(car p)f)(RoundUp(cadr p)f)(RoundUp(caddr p)f)))
(setq tor (car(getvar 'GridUnit))); 採用系統格點間距，可自行設定格點間距(需為1/x值)，例如:0.1, 0.5, 0.25, 0.125
(prompt (strcat "\n將採用系統格點間距GridUnit:" (rtos tor 2 2) "來調整端點座標，請選線或聚合線:"))
(setq ss (ssget '((0 . "LINE,LWPOLYLINE"))) i -1)
(repeat (sslength ss)
(setq xen(vlax-ename->vla-object (ssname ss (setq i (1+ i))))cs nil)
(cond
((=(vla-Get-ObjectName xen)"AcDbPolyline")
(ForEach c(vl(vla-get-Coordinates xen))(setq cs(Append cs(List(RoundUp c tor)))))
(vla-put-coordinates xen (lv cs)))
((=(vla-Get-ObjectName xen)"AcDbLine")
(vla-put-StartPoint xen(lv(fixPt(vl(vla-get-startpoint xen))tor)))
(vla-put-EndPoint xen(lv(fixPt(vl(vla-get-endpoint xen))tor))))))
(princ))

請問此lisp載入後要如何使用

小五 寫到:請問此lisp載入後要如何使用

先設定系統網格參數GridUnit
如:0.5
輸入指令:fix
選取線或聚合線

好像斜線弄不出來，而且請問是移動的那一條線，是先選擇到的還是后選擇到

感謝PIZG前輩的程式分享,我也下載來使用了,對於來圖中有帶很多小數的線段,透過這個程式的校正,真的大大節省了許多時間,真是太好用了!
感恩吶!

很實用的程式感謝PIZG的分享

這程式經過我的測試好像只能修正直線和聚合直線的接點處，請問有辦法再加進弧線嗎?

這樣這程式就非常棒了，功能盡善完美，要是還能再加雲行線，難度很高嗎?

謝謝！

太感謝PIZG的分享
能夠做到這樣的程度
真的是要深入才行
讚+1

PIZG大大有辦法增加弧線的功能嗎?感謝你提供這個好程式。

aaronchung.tw 寫到:PIZG大大有辦法增加弧線的功能嗎?感謝你提供這個好程式。

請問你弧線的處理規則是什麼?

這程式太好用了，容我收藏，感謝PIZG大。

非常謝謝,這個超好用的,
事務所常被這樣的問題困惱,
光人工調整小數點就非常耗時,
因為這個的方便讓我想加入贊助會員,

請問PIZG大大,
FIXDWG您提供的小數點整數功能非常強大,很好用!!
只是有一個小問題不知道您有沒有方法可以解決,

當輸入FIXDWG後,線段會自動移位,例如原本線條在(0,0)會自動微調位置至(0.9,1.3),
即使線段無小數點,同樣也會跳位,
以致有時線段之間會產生0.5與1cm的空隙,無連結再一起,

還請您多幫忙,謝謝您,

請問為什麼我一樣複製了語法轉乘lsp
卻出現了上面的問題，載入後出現錯誤，
我的autocad 是2018的版本，謝謝

bsl 寫到:

請問為什麼我一樣複製了語法轉乘lsp
卻出現了上面的問題，載入後出現錯誤，
我的autocad 是2018的版本，謝謝

我試了一下，用visual lisp編輯器打開把每行開頭?的地方刪掉就可以正常運作了

franwist 寫到:我試了一下，用visual lisp編輯器打開把每行開頭?的地方刪掉就可以正常運作了

謝謝回報，我也補上傳程式囉