[原创]：折断线、波浪线、波折线、云图线程序（最新版，免币！）

武陵山人

最初由 xyp1964 发布
[B]回复flowerson：
发个示意图看看！
控制鼠标的移动速度，也许会稍有改进。 [/B]

flowerson 应该是要这样的效果吧：

梦断江南

……
(setq pt1 (getpoint "\n起点位置<退出> :"))
(if pt1
  (setq pt2 (getpoint pt1 "\n终点位置<退出> :"))
)
(while pt2
  ……
  (if pt1
    (setq pt2 (getpoint pt1 "\n终点位置<退出> :"))
  )
)
……

试试：

2. 
   
3. (if (and (setq pt1 (getpoint "\n起点位置<退出> :"))
   
4.          (setq pt2 (getpoint pt1 "\n终点位置<退出> :"))
   
5.     )
   
6.    (while pt2
   
7.     ……
   
8.      (if pt1
   
9.        (setq pt2 (getpoint pt1 "\n终点位置<退出> :"))
   
10.      )
    
11.    )
    
12. )

<br /> (if (and (setq pt1 (getpoint "\n起点位置<退出> :"))<br />          (setq pt2 (getpoint pt1 "\n终点位置<退出> :"))<br />     )<br />    (while pt2 <br />     …… <br />      (if pt1 <br />        (setq pt2 (getpoint pt1 "\n终点位置<退出> :")) <br />      ) <br />    )<br /> )

andyhua5240

程序赶快试试吧，斑竹出手，非同小可呀！这下…………应该没有问题了吧？？？？

xyp1964

自己试试吧，或请斑竹出手解惑！
[php]
;;;折断线
(DEFUN C:test (/ PT1 PT2 PT3 PT4 PT5 PT6 PT7 ANG)
  (CMDLA0)
  (setq        NO2 (@Ureal 1 "" "\n折断长" NO2)
        no1 (/ no2 2)
        no3 (@Ureal 1 "" "\n两端出头长" NO3)
  )
  (if (setq pt1 (getpoint "\n起点位置<退出> :"))
    (setq pt2 (getpoint pt1 "\n终点位置<退出> :"))
  )
  (while pt2
    (setq pt3 (LIST (+ (CAR PT1) (/ (- (CAR PT2) (CAR PT1)) 2))
                    (+ (CADR PT1) (/ (- (CADR PT2) (CADR PT1)) 2))
              )
    )
    (setq ang (angle pt1 pt2)
          pt4 (POLAR PT3 ANG no1)
          pt5 (POLAR PT3 ANG (- 0 no1))
          pt6 (POLAR PT3 (+ (/ PI 2) ANG) (* 1.50 no1))
          pt7 (POLAR PT3 (- ANG (/ PI 2)) (* 1.50 no1))
          pt1 (polar pt1 (+ ang pi) no3)
          pt2 (polar pt2 ang no3)
    )
    (setvar "plinewid" 0)
    (setq osm (getvar "osmode"))
    (SETVaR "osmode" 0)
    (command "PLINE" PT1 PT5 PT6 PT7 PT4 PT2 "")
    (SETVaR "osmode" osm)
    (if        (setq pt1 (getpoint "\n起点位置<退出> :"))
      (setq pt2 (getpoint pt1 "\n终点位置<退出> :"))
    )
  )
  (CMDLA1)
)
;;;-------------------------------------------
;;;通用子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
)

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
)
;;;
(defun @ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getreal msg))
  (if inp
    inp
    def
  )
)
[/php]

梦断江南

试改如下
[php]

;;;折断线
(DEFUN C:test (/ PT1 PT2 PT3 PT4 PT5 PT6 PT7 ANG)
  (CMDLA0)
  (setq    NO2 (@Ureal 1 "" "\n折断长" NO2)
    no1 (/ no2 2)
    no3 (@Ureal 1 "" "\n两端出头长" NO3)
  )
  (while (and(setq pt1 (getpoint "\n起点位置<退出> :"))
          (setq pt2 (getpoint pt1 "\n终点位置<退出> :")) )
    (setq pt3 (LIST (+ (CAR PT1) (/ (- (CAR PT2) (CAR PT1)) 2))
            (+ (CADR PT1) (/ (- (CADR PT2) (CADR PT1)) 2))
          )
    )
    (setq ang (angle pt1 pt2)
      pt4 (POLAR PT3 ANG no1)
      pt5 (POLAR PT3 ANG (- 0 no1))
      pt6 (POLAR PT3 (+ (/ PI 2) ANG) (* 1.50 no1))
      pt7 (POLAR PT3 (- ANG (/ PI 2)) (* 1.50 no1))
      pt1 (polar pt1 (+ ang pi) no3)
      pt2 (polar pt2 ang no3)
    )
    (setvar "plinewid" 0)
    (setq osm (getvar "osmode"))
    (SETVaR "osmode" 0)
    (command "PLINE" PT1 PT5 PT6 PT7 PT4 PT2 "")
    (SETVaR "osmode" osm)  
  )
  (CMDLA1)
)
;;;-------------------------------------------
;;;通用子程序
;;;
(defun CMDLA0 ()
  (setq cmdech (getvar "CMDECHO"))
  (setq oom (getvar "orthomode"))
  (setq osm (getvar "osmode"))
  (SETQ LA (getvar "clayer"))
  (setq rmode (getvar "regenmode"))
  (setq pw (getvar "plinewid"))
  (setvar "regenmode" 0)
  (setvar "CMDECHO" 0)
  (princ)
)

;;;
(defun CMDLA1 ()
  (setvar "CMDECHO" cmdech)
  (setvar "orthomode" oom)
  (setvar "osmode" osm)
  (setvar "clayer" LA)
  (setvar "regenmode" rmode)
  (setvar "plinewid" pw)
  (princ)
)
;;;
(defun @ureal (bit kwd msg def / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")
      bit (* 2 (fix (/ bit 2)))
    )
    (setq msg (strcat "\n" msg ": "))
  )
  (initget bit kwd)
  (setq inp (getdist msg))
  (if inp
    inp
    def
  )
)

[/php]

andyhua5240

老大，你能不能按斑竹的程序改改你的程序呀？
谢谢！

xyp1964

多谢斑竹指教，再修改，见1楼！

bluesky1000

真厉害呀！

xyp1964

下一步修改将改为对话框。

武陵山人

最初由 xyp1964 发布
[B]下一步修改将改为对话框。 [/B]

支持改为对话框，现在画一条线要回车的次数太多，一不小心多按一次又得重新来过。如果能在对话框中加入预览功能就更好了。

xyp1964

“预览功能”功能偶可不会，不过可以增加图像（幻灯片）显示功能。

xyp1964

对话框编辑成功！
程序见1楼！

hmh888888

xyp1964  兄，你的程序是fas格式，可以启动cad时自动加载吗？
用aut 管理不支持fas格式的，能否编成vlx 格式

andyhua5240

兄弟，一个程序要好好的用，才能知道它的功能的！

rat-saint

6-任意线转波浪线/7-任意线转波折线
好象不行啊