增强对象修订云线,增加设置选项及快速恢复默认值

lanjqka

初学,看到有增强的云线,开始想加一个设置选项,后来还加了一个默认设置,最后变成了命令行分级.基本改成CAD的命令行风格,还没有学习DCL,对命令行的模式感受比较深刻.献丑

;;  yx.lsp lanjqka 20130914
;;  增强对象修订云线,增加设置选项及快速恢复默认值
;;  yx

(defun c:yx (/)
  (vl-load-com)
  (setq variation_cmdecho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (if stringcommandline
    (setq stringcommandline (:yx:_Make_select))
    (setq stringcommandline "Reset")
    );用于首次加载预设参数
  (while (/= stringcommandline "Exit");退出条件
    (cond
      ((= stringcommandline "Reset");命令行选项 初始设置
       (setq objectstyle "Circle");对象类型
       (setq chordlengthmin1 500.0);正数
       (setq chordlengthmin2 -24.0);负数
       (setq chordlengthmin0 chordlengthmin2);chordlengthmin1 或者 chordlengthmin2
       (setq dividenumber (- chordlengthmin2));负数修正
       (setq chordlengthmax0 500.0);负数
       (print "OK!");完成标记
       )
      ((= stringcommandline "Set");命令行选项 设置
       (setq objectstyletemp objectstyle)
       (initget "Circle Ellipse Polygon Rectang")
       (setq objectstyle
             (getkword (strcat "\n输入对象类型 [Circle/Ellipse/Polygon/Rectang] <" objectstyletemp ">:"))
             )
       (if (not objectstyle) (setq objectstyle objectstyletemp))
       (initget)
       (cond ((> chordlengthmin0 0) (setq chordlengthmin1 chordlengthmin0))
             ((< chordlengthmin0 0) (setq chordlengthmin2 chordlengthmin0))
             (T nil)
             )
       (setq chordlengthmin0
             (getreal (strcat "\n指定最小弧长[正数/0-上一次数值:"
                              (rtos chordlengthmin1 2 0)
                              "/负数-自动分割数]<"
                              (rtos chordlengthmin2 2 0)
                              ">:"
                              )
                      )
             )
       (if chordlengthmin0
         (cond ((= chordlengthmin0 0) (setq chordlengthmin0 chordlengthmin1))
               ((< chordlengthmin0 0) (setq dividenumber (- chordlengthmin0)))
               (T nil)
               )
         (setq chordlengthmin0 chordlengthmin2 dividenumber (- chordlengthmin0))
         )
       (if (> chordlengthmin0 0)
         (progn        ;|(print "弧长最大值不小于最小值.否则,自动修正弧长最小值按小者.")
                (print "弧长最大值不超过最小值3倍.否则,自动修正弧长最大值为最小值3倍.")|;
                (initget 4)
                (if (> chordlengthmax0 0) (setq chordlengthmax1 chordlengthmax0))                  
                (setq chordlengthmax0
                      (getreal (strcat "\n指定弧长最大值[正数/0-上一次数值:"
                                       (rtos chordlengthmax1 2 0)
                                       "]<0-上一次数值:" (rtos chordlengthmax1 2 0) ">"
                                       )
                               )
                      )
                (if chordlengthmax0
                  (if (= chordlengthmax0 0) (setq chordlengthmax0 chordlengthmax1))
                  (setq chordlengthmax0 chordlengthmax1)
                  )
                )
         )
       )
      ((= stringcommandline "Draw");命令行选项 画
       (setq element nil);清空对象单元
       (initget 1)
       (cond ((= objectstyle "Circle");画 圆
              (command ".CIRCLE" (getpoint "\n指定圆心:") PAUSE) ;指定半径
              (setq element (entlast));获取对象并作为云线条件 以下同
              (setq lengthtotle (Vlax-Get (Vlax-Ename->Vla-Object element) 'Circumference));获取对象周长 以下同
              )
             ((= objectstyle "Ellipse");画 椭圆
              (command ".Ellipse" (setq pt1 (getpoint "\n指定轴线端点:")) (getpoint pt1 "\n指定轴线另一端点:") PAUSE) ;指定另一轴线端
              (setq element (entlast))
              (setq lengthMajorRadius (Vlax-Get (Vlax-Ename->Vla-Object element) 'MajorRadius))
              (setq lengthMinorRadius (Vlax-Get (Vlax-Ename->Vla-Object element) 'MinorRadius))
              (setq lengthtotle (+ (* 2.0 Pi lengthMinorRadius ) (* 4.0 (- lengthMajorRadius lengthMinorRadius))))
              )
             ((= objectstyle "Polygon");画 多边形
              (command ".PLINE" (setq pt0 (getpoint "指定起点:")) "Width" 0 0)
              (setq pts pt0)
              (while (setq ptn (getpoint pts "\n指定下一点:")) (command ptn) (setq pts ptn))
              (command "Close");闭合
              (setq element (entlast))
              (setq lengthtotle (Vlax-Get (Vlax-Ename->Vla-Object element) 'Length))
              )
             ((= objectstyle "Rectang");画 矩形
              (command ".RECTANG" (setq pt1 (getpoint "\n指定第一角点:")) (getcorner pt1 "\n指定另一角点:"))
              (setq element (entlast))
              (setq lengthtotle (Vlax-Get (Vlax-Ename->Vla-Object element) 'Length))
              )
             (T nil);条件闭合
             )
       (if element ;判断是否已画出对象
         (progn        (if (< chordlengthmin0 0) ;判断是否自动分割
                  (setq        chordlengthmin (/ lengthtotle dividenumber)
                        chordlengthmax (/ lengthtotle dividenumber))
                  (setq        chordlengthmin (min chordlengthmin0 chordlengthmax0)
                        chordlengthmax (min (* 3.0 chordlengthmin0) chordlengthmax0));自动修正弧长条件
                  )
                ;;画 云线 样式手绘 对象按预设 不反向
                (command ".REVCLOUD" "Style" "Calligraphy" "Arc" chordlengthmin chordlengthmax "Object" "" element "No")
                )
         )
       (setq element nil);释放对象单元
       (redraw)
       )
      (T nil)
      )
    (setq stringcommandline (:yx:_Make_select));循环运行
    )
  (setvar "CMDECHO" variation_cmdecho)
  (princ)
  )




;;  生成命令行菜单选项
;;  (:yx:_Make_select)

(defun :yx:_Make_select (/)
  (print (strcat "当前对象类型:" objectstyle));信息显示
  (if (< chordlengthmin0 0);判断是否自动分割
    (print (strcat "当前弧长按自动分割:" (rtos dividenumber 2 0)));信息显示
    (print (strcat "当前弧长最小值,最大值:" (rtos chordlengthmin0 2 0) "," (rtos chordlengthmax0 2 0)))
    )
  (initget "Draw Set Reset Exit")
  (setq Draw_Set_Reset_Exit (getkword "\n请输入指令 [Draw/Set/Reset/Exit] <Draw>"));默认"Draw"
  (if (not Draw_Set_Reset_Exit) (setq Draw_Set_Reset_Exit "Draw"))
  (print Draw_Set_Reset_Exit)
  )

adc

请问怎样改成右键退出？

lanjqka

开始退出看更改退出条件是否可行
command中退出没有控制

lanjqka

command有时很难调试
有些命令可以用vl