增强对象修订云线,增加设置选项及快速恢复默认值
初学,看到有增强的云线,开始想加一个设置选项,后来还加了一个默认设置,最后变成了命令行分级.基本改成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输入对象类型 <" 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>"));默认"Draw"
(if (not Draw_Set_Reset_Exit) (setq Draw_Set_Reset_Exit "Draw"))
(print Draw_Set_Reset_Exit)
) 请问怎样改成右键退出？ 开始退出看更改退出条件是否可行
command中退出没有控制 command有时很难调试
有些命令可以用vl
页:
[1]