yusen7277 发表于 2010-5-13 18:22

AutoCADLISP使用中的问题

本人制作一路桥专业使用的lisp函数，功能：依据输入的路线交点参数算要求点的坐标，并在绘图区绘出图形。
但是在使用中发现多次发现，适合一次调用，多次调用时就出现计算坐标结果正确，但是就是部分点绘到一块去了（如图）：
问题出在使用自动序列时，第一次计算，计算的X、Y、方位角值均正确，绘出的图形也没有错误，可若是不重新启动CAD的话，再调用dqx命令就可能出现计算的坐标及方位角均正确，绘出的图形重叠显示。我试验三次的桩号间距分别为5、2.5、1，到桩号为1的时候就出现重叠了，再继续下去也是结果正确绘图重叠。特点好似桩号间距递增（如5、10、15、20……）不出现问题，但桩号间距递减（如10、5、2.5、1）就出现问题了。不能像CAD命令那样在不重启CAD的情况下多次使用。


函数代码如下：（参数区我已经赋值）
(defun c:dqx( / qs qz qszb qs_a qsr qzr k ls ma mi dzh dzh1 jl j n )
(setvar "cmdecho" 0)
(princ "\n-------------------------------------------------------------")
(princ "\n    （^_^） 于森制作，欢迎使用。[email protected] （^_^） ")
(princ "\n-------------------------------------------------------------")
;(setq qs (getreal "\n输入曲线始点桩号："))
(setq qs 25650.926)
;(setq qz (getreal "\n输入曲线终点桩号："))
(setq qz 25900.926)
;(setq qszb (getpoint "\n输入或拾取曲线始点坐标："))
(setq qszb '( 3252647.051 381399.471))
;(setq qs_a (getreal "\n输入曲线始点顺曲线桩号递增方向的计算方位角(弧度)："))
(setq qs_a 2.907134)
(if (> qs qz) (setq qs_a (+ qs_a pi)))
;(setq qsr (getreal "\n输入曲线始点半径(半径=∞时为0)："))
(setq qsr 3650)
(if (= qsr 0) (setq qs_ql (/ 1 10000000)) (setq qs_ql (/ 1 qsr)))
;(setq qzr (getreal "\n输入曲线终点半径(半径=∞时为0)："))
(setq qzr 1295.3)
(if (= qzr 0) (setq qz_ql (/ 1 10000000)) (setq qz_ql (/ 1 qzr)))
;(setq k (getreal "\n选择顺曲线桩号递增方向的转向[左(-1)\\右(1)]："))
(setq k -1)
(setq ls (- qz qs))
(setq dzh qs)
(setq ma (max qs qz) mi (min qs qz))
(princ "\n-------------------------------------------------------------")
(princ "\n       开始桩号坐标计算,请输入曲线始点至终点间的桩号!")
(princ "\n-------------------------------------------------------------")
(setq dzh (getreal "\n输入桩号[自动序列(-2)]："))
(if (= dzh -2)
    (progn
      (setq jl (getreal "\n输入自动序列的桩号间距："))
      (setq j 0)
      (setq dzh (+ 10 (* 10 (fix (/ mi 10)))))
      (zbjs dzh)
      (setq n (- (fix (/ (- (fix ma) dzh) jl)) 1))
      (while (<= j n)
(setq dzh1 (+ dzh (* j jl)))
(setq j (+ 1 j))
(zbjs dzh1)
)
      )
    (setq dzh ma)
    )
(while (/= dzh -1)
    (if (or (> dzh ma) (< dzh mi))
      (princ "\n提示：输入桩号不在曲线始点至终点间，请重新输入!")
      (zbjs dzh)
      )
    (setq dzh (getreal "\n输入下一个桩号[放弃(-1)]："))
)
(command "zoom" "e")
(setvar "cmdecho" 1)
(princ)
)
(defun zbjs(zh / l a i ac as p a_f x y x1 y1 xy zh0 zh1 zh2 a5 a6 a7 )
(setq l (- zh qs))
(setq a (list 1 2 3 4))
(setq i 1 ac 0 as 0)
(setq xy (list "" ""))
(while (<= i 4)
    (setq p (+ qs_ql (* (/ (* (/ l 4) i) ls) (- qz_ql qs_ql))))
    (setq a_f (+ qs_a (* k (/ (* (+ p qs_ql) (* (/ l 4) i)) 2))))
    (if (= i 2) (setq ac (+ ac (* 2 (cos a_f))) as (+ as (* 2 (sin a_f)))))
    (if (= (rem i 2) 1) (setq ac (+ ac (* 4 (cos a_f))) as (+ as (* 4 (sin a_f)))))
    (setq i (1+ i))
    )
(setq ac (+ ac (cos qs_a) (cos a_f)) as (+ as (sin qs_a) (sin a_f)))
(setq x(+ (car qszb) (* (/ (abs l) 12) ac)))
(setq y (+ (cadr qszb) (* (/ (abs l) 12) as)))
;(setq x1 (rtos x 2 5) y1 (rtos y 2 5))
(setq xy (list x y))
(command "point" xy)
(setq zh0 (rtos (fix (/ zh 1000)) 2 0))
(setq zh1 (rtos(- zh (* 1000 (fix (/ zh 1000)))) 2 3))
(setq zh2 zh1)
(setq a5 a_f)
(if (> qs qz) (setq a5 (- a5 pi)))
(if (> a5 (* 2 pi)) (setq a5 (- a5 (* 2 pi))))
(if (< a5 0) (setq a5 (+ a5 (* 2 pi))))
(setq a6 (rtos a5 2 6))
(setq zh1 (strcat " K" zh0 "+" zh1 " A=" a6 "r"))
(setq a7 (rtos (- (* a5 57.295779513) 90) 2 6))
(command "text" xy "0.25" a7 zh1)
(setq x1 (rtos x 2 4) y1 (rtos y 2 4))
(setq a5 (* a5 57.295779513))
(setq a5 (rtos a5 2 6))
(princ (strcat "\n结果：" " K" zh0 "+" zh2 "X=" x1 "Y=" y1 "A=" a5" 度\n" ))
)

Camello 发表于 2010-5-13 18:28

您先关闭捕捉再试

yusen7277 发表于 2010-5-13 18:45

回复 #2 Camello 的帖子

谢谢，我将对象捕捉关掉就可以了。但是不明白这个和捕捉怎么有关系了，我绘图可指定的绝对坐标，怎么还能绘到一块去了？
页: [1]
查看完整版本: AutoCADLISP使用中的问题