求教高手，我这个程序应怎么循环

yjpzc · 发表于 2009-11-17 11:58:00

(defun c:v( / pp1 pp2 a s ang b mpt)
   (command "osnap" "mid" "")
   (command "layer" "s" "0" "")
   (while
   (setq pp1 (getpoint "point pt1"))
   (setq pp2 (getpoint "point pt2"))
   (command "pline" pp1 pp2 "")
   (setq s (distance pp1 pp2))
   (setq a (rtos s 2 2 ))
   (setq ang (angle pp1 pp2))
   (setq b (* (/ ang pi) 180))
   (setq hs ( / s 2))
   (setq hx (polar pp1 ang hs));;;;;;;取得线段的中点
;;获取角度
(if    (> (* (/ ang pi) 180) 180)
    (setq ang (+ ang pi))
)
(command "text" "j" "c" hx "0.30" b a)
(setq pp1 pp2 ) (command pp2)
)
)
(prin1)
)
(prompt "\n <<length>>在图中直接写出长度")

(prin1)

phoenixdjq · 发表于 2009-11-17 14:31:00

在你程序的基础上改了一下

(defun c:v( / pp1 pp2 a s ang b mpt)
(setvar "osmode" 2)
(command "layer" "s" "0" "")

(setq pp1 (getpoint "\n point pt1"))
(setq pp2 (getpoint "\n point pt2"))

   (while (and (/= pp1 nil)(/= pp2 nil) )

   (command "pline" pp1 pp2 "")
   (setq s (distance pp1 pp2))
   (setq a (rtos s 2 2 ))
   (setq ang (angle pp1 pp2))
   (setq b (* (/ ang pi) 180))
   (setq hs ( / s 2))
   (setq hx (polar pp1 ang hs))

(if (> (* (/ ang pi) 180) 180)
(setq ang (+ ang pi))
)
(command "text" "j" "c" hx "0.30" b a)
(setq pp1 pp2 ) (command pp2)

(setq pp1 (getpoint "point pt1"))
(setq pp2 (getpoint "point pt2"))
)
(prin1)
)

(prompt "\n <<length>>在图中直接写出长度")

(prin1)

yjpzc · 发表于 2009-11-18 20:00:00

谢谢您的指教。。。。。

还是不能实现我想要那个郊果，我想把程度变得就像画多段线那样。一边画线一边注记长度。

phoenixdjq · 发表于 2009-11-18 21:18:00

我试过，可以的，也许是文字太小，你看不见

你再试试看，如果不行，我们再联系！

yjpzc · 发表于 2009-11-18 21:39:00

不是文字是线段不能连续

xianaihua · 发表于 2009-11-18 22:27:00

[UseMoney=5]

(defun c:draw_pline (/ lst ct pt1 pt2 pt3)
(setq lst '())
(setq pt1 (getpoint "\n点取第一点: "))
(if pt1
(progn (setq lst (append lst (list pt1)))
(initget 1)
(while (setq pt2 (getpoint pt1 "\n下一点: "))
(grdraw pt1 pt2 7 0)
(setq s (distance pt1 pt2))
(setq a (rtos s 2 2))
(setq ang (angle pt1 pt2))
(setq b (* (/ ang pi) 180))
(setq hs (/ s 2))
(setq hx (polar pt1 ang hs))
(if (> (* (/ ang pi) 180) 180)
(setq ang (+ ang pi))
)
(command "text" "j" "c" hx "5" b a)
(setq lst (append lst (list pt2)))
(setq pt3 pt1
pt1 pt2
)
)
(setq ct 1)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "pline" (nth 0 lst))
(while (nth ct lst) (command (nth ct lst)) (setq ct (1+ ct)))
(command "")
(redraw)
)
)
)

(defun c:draw_pline (/ lst ct pt1 pt2 pt3)
  (setq lst '())
  (setq pt1 (getpoint "\n点取第一点: "))
  (if pt1
    (progn (setq lst (append lst (list pt1)))
           (initget 1)
           (while (setq pt2 (getpoint pt1 "\n下一点: "))
             (grdraw pt1 pt2 7 0)
             (setq s (distance pt1 pt2))
             (setq a (rtos s 2 2))
             (setq ang (angle pt1 pt2))
             (setq b (* (/ ang pi) 180))
             (setq hs (/ s 2))
             (setq hx (polar pt1 ang hs))
             (if (> (* (/ ang pi) 180) 180)
               (setq ang (+ ang pi))
             )
             (command "text" "j" "c" hx "5" b a)
             (setq lst (append lst (list pt2)))
             (setq pt3 pt1
                   pt1 pt2
             )
           )
           (setq ct 1)
           (setvar "cmdecho" 0)
           (setvar "osmode" 0)
           (command "pline" (nth 0 lst))
           (while (nth ct lst) (command (nth ct lst)) (setq ct (1+ ct)))
           (command "")
           (redraw)
    )
  )
)

[/UseMoney]

xianaihua · 发表于 2009-11-18 22:38:00

以上程序不知能不能满足朋友的要求？

yjpzc · 发表于 2009-11-19 00:11:00

谢谢__

大致意思是这样，但还不够完美，线段不能闭合，和选择其它二级命令选项

yjpzc · 发表于 2009-11-19 16:38:00

有高手能指导一下吗？

xianaihua · 发表于 2009-11-19 21:20:00

这个朋友的要求还很高呀,不过好像也能实现

源程序下载：

账号		自动登录	找回密码
密码			注册

[基础] 求教高手，我这个程序应怎么循环

本帖子中包含更多资源

本帖子中包含更多资源