穿越的兔子889 发表于 2012-12-6 10:59:09

求高手做一个有点搞的转换lsp程序

要求如下，有一段长度为L的线段，精度为小数点后一位，如果L的小数尾数为0，1或2，则小数尾数取0；
如果小数尾数为3，4，5，6或7则小数尾数取5；如果小数尾数为8或9，则自动进1，小数尾数仍然取0.

打个比方，如果是12.0,12.1,12.2，则该数取值为12.0；
如果是12.3,12.4,12.5,12.6,12.7，则该数取值为12.5；
如果是12.8,12.9，则该数取值为13.0

有点搞，希望高手能解答，做一段lsp程序，谢谢了！


http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 穿越的兔子889的微博

ll_j 发表于 2012-12-6 11:30:42

(defun dg (x)
(+ (fix x)
   (cond ((<= (rem x 1) 0.25) 0.0)
   ((>= (rem x 1.0) 0.75) 1.0)
   (t 0.5)
   )
)
)

ZZXXQQ 发表于 2012-12-6 11:43:25


;线长调整 明经 ZZXXQQ 2012.12.6
(defun c:tt ()
(if (and (princ "\n选择直线 :") (setq ss (ssget '((0 . "LINE"))))) (progn
(setq i -1)
(repeat (sslength ss)
   (setq ent (entget (ssname ss (setq i (1+ i))))
         p1 (cdr(assoc 10 ent))
         p2 (cdr(assoc 11 ent))
         dt (distance p1 p2)
         ddt (/ (fix (+ dt dt 0.5)) 2.0)
         p2 (polar p1 (angle p1 p2) ddt))
   (entmod (subst (cons 11 p2) (assoc 11 ent) ent))
)
))
(princ)
)

穿越的兔子889 发表于 2012-12-6 11:45:11

(defun dg (x)
(+ (fix x)   
(cond ((<= (rem x 1) 0.25) 0.0)   
((>= (rem x 1.0) 0.75) 1.0)   
(t 0.5)   
)
)
)

(defun c:pljl1 (l)
dg(l)
)
我用这段代码，好像有错误啊，请看看是什么问题

zyhandw 发表于 2012-12-6 11:56:03

穿越的兔子889 发表于 2012-12-6 11:45 static/image/common/back.gif
(defun dg (x)
(+ (fix x)   
(cond ((= (rem x 1.0) 0.75) 1.0)   


试过了，没什么问题啊，结果是正确的，符合你的要求。

穿越的兔子889 发表于 2012-12-6 12:02:37

(defun c:pljl1 (/ ll)
(setvar "cmdecho" 0)
(setq ffn (getfiled "选取文件" "" "doc" 1))
(setq ff (open ffn "w"))
(close ff)
(if (= bl1 nill) (setq bl1 1.0))
(setq bls (rtos bl1 2 1))
(setq blss (strcat "\n请输入图纸比例<" bls">:"))
(setq bl (getreal blss))
(if (= bl nill) (setq bl bl1 ))
(setq bl1 bl)
(princ "\n选择多义线")
(setq ss (ssget))
(setq i 0)
(setvar "pdmode" 33)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq a ssn)
(setq num (cdr (assoc 90 (entget a))) n 1)
(setq FF (open FFN "a"))
(while (< n num)
    (setq l (- (vlax-curve-getDistAtParam a n)
               (vlax-curve-getDistAtParam a (1- n)))
          n (1+ n)
          l (/ l bl)
          l (rtos l 2 1)
          l (dg(l))
    )
    (princ l ff)
    (princ " " FF)
)
(princ "\n" ff)
(close ff)
(setq i (1+ i))
)
)

原代码在这里，我就是想加在这里面的，结果加了代码进去就显示错误

穿越的兔子889 发表于 2012-12-6 12:10:33

(defun c:pljl1 (/ ll)
(setvar "cmdecho" 0)
(setq ffn (getfiled "选取文件" "" "doc" 1))
(setq ff (open ffn "w"))
(close ff)
(if (= bl1 nill) (setq bl1 1.0))
(setq bls (rtos bl1 2 1))
(setq blss (strcat "\n请输入图纸比例<" bls">:"))
(setq bl (getreal blss))
(if (= bl nill) (setq bl bl1 ))
(setq bl1 bl)
(princ "\n选择多义线")
(setq ss (ssget))
(setq i 0)
(setvar "pdmode" 33)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq a ssn)
(setq num (cdr (assoc 90 (entget a))) n 1)
(setq FF (open FFN "a"))
(while (< n num)
    (setq l (- (vlax-curve-getDistAtParam a n)
               (vlax-curve-getDistAtParam a (1- n)))
          n (1+ n)
          l (/ l bl)
          l (rtos l 2 1)
          l (dg (l))
    )
    (princ l ff)
    (princ " " FF)
)
(princ "\n" ff)
(close ff)
(setq i (1+ i))
)
)

(defun dg (x)
(+ (fix x)
   (cond ((<= (rem x 1) 0.25) 0.0)
   ((>= (rem x 1.0) 0.75) 1.0)
   (t 0.5)
   )
)
)

加进去以后的完整代码如上所示，显示函数错误

ZZXXQQ 发表于 2012-12-6 12:31:13

;...
(setq l (- (vlax-curve-getDistAtParam a n)
               (vlax-curve-getDistAtParam a (1- n)))
          n (1+ n)
          l (dg(/ l bl))
          l (rtos l 2 1))
;...

穿越的兔子889 发表于 2012-12-6 13:30:01

ZZXXQQ 发表于 2012-12-6 12:31 static/image/common/back.gif
;...
(setq l (- (vlax-curve-getDistAtParam a n)
               (vlax-curve-getDistAtParam a (1- n ...

已经可以了，非常感谢！

Andyhon 发表于 2012-12-6 15:32:55

(defun Rd05 (x)
(/ (fix (+ (* x 2) 0.5)) 2.0)
)
页: [1]
查看完整版本: 求高手做一个有点搞的转换lsp程序