框选画云线程序
本帖最后由 yucpp 于 2011-1-28 13:24 编辑;;此云线使用pline做的，为了使之醒目，pline的开始点宽度为0，结束点宽度570， (command "w" 0 570 "a")
;;这两个值是我做程序的时候调试写的，用户要自己改下，否则画出的线条可能不合适
;;程序命令：kk
;;find_peak_point_left 找出选择框的左上角点
(defun find_peak_point_left (aa0 bb0 / calu_pos_ori_x calu_pos_ori_y)
(if (> (car aa0) (car bb0))
(setq calu_pos_ori_x (car bb0))
(setq calu_pos_ori_x (car aa0))
)
(if (> (cadr aa0) (cadr bb0))
(setq calu_pos_ori_y (cadr aa0))
(setq calu_pos_ori_y (cadr bb0))
)
(setq calu_pos_ori (list calu_pos_ori_x calu_pos_ori_y 0))
)
;;find_peak_point_right 找出选择框的右下角点
(defun find_peak_point_right (aa0 bb0 / calu_pos_ori_x calu_pos_ori_y)
(if (< (car aa0) (car bb0))
(setq calu_pos_ori_x (car bb0))
(setq calu_pos_ori_x (car aa0))
)
(if (< (cadr aa0) (cadr bb0))
(setq calu_pos_ori_y (cadr aa0))
(setq calu_pos_ori_y (cadr bb0))
)
(setq calu_pos_ori (list calu_pos_ori_x calu_pos_ori_y 0))
)
(defun c:kk ()
(setq oldos (getvar "osmode"))
(setq aa_point (getpoint "\n点取云线起点:"))
(setq bb_point (getcorner aa_point "\n点取云线终点:"))
(setq s_point (find_peak_point_left aa_point bb_point));左上角点
(setq e_point (find_peak_point_right aa_point bb_point));右下角点
(setq AllXyList nil)
(setvar "cmdecho" 0)
(setq dengfen 5) ;等分20份
(if (<= (abs (- (car e_point) (car s_point)))
(abs (- (cadr e_point) (cadr s_point)))
)
(setq steplen (/ (abs (- (car e_point) (car s_point))) dengfen))
(setq steplen (/ (abs (- (cadr e_point) (cadr s_point))) dengfen))
) ;if 步长
;;下面计算应该生成的圆弧个数,实际上短边方向是已知的，不过再判断一次比较方便
(setq x_num (fix (/ (abs (- (car e_point) (car s_point))) steplen)))
;x方向数量
(setq y_num (fix (/ (abs (- (cadr e_point) (cadr s_point))) steplen)))
;y方向数量
(setq s_xunhuan s_point
e_xunhuan e_point
)
;;下面计算所有的点坐标，并存入一个表中供调用
(repeat x_num
(setq next_point
(list (+ (car s_xunhuan) steplen)
(cadr s_xunhuan)
(caddr s_xunhuan)
)
) ;计算下一个点
(setq AllXyList (cons s_xunhuan AllXyList)) ;收集坐标点
(setq s_xunhuan next_point)
) ;计算x方向坐标，方向从左向右
(repeat y_num
(setq next_point
(list (car s_xunhuan)
(- (cadr s_xunhuan) steplen)
(caddr s_xunhuan)
)
) ;计算下一个点
(setq AllXyList (cons s_xunhuan AllXyList)) ;收集坐标点
(setq s_xunhuan next_point)
) ;计算y方向坐标，方向从上到下
(repeat x_num
(setq next_point
(list (- (car s_xunhuan) steplen)
(cadr s_xunhuan)
(caddr s_xunhuan)
)
) ;计算下一个点
(setq AllXyList (cons s_xunhuan AllXyList)) ;收集坐标点
(setq s_xunhuan next_point)
) ;计算x方向坐标，方向从右向左
(repeat y_num
(setq next_point
(list (car s_xunhuan)
(+ (cadr s_xunhuan) steplen)
(caddr s_xunhuan)
)
) ;计算下一个点
(setq AllXyList (cons s_xunhuan AllXyList)) ;收集坐标点
(setq s_xunhuan next_point)
) ;计算y方向坐标，方向从下到上
(setq AllXyList (reverse (cons s_point AllXyList)))
;把起点的坐标加进去，构成闭合图形
(setvar "osmode" 0)
(command ".pline")
(setq FriFlags 0)
(foreach x AllXyList
(command x) ;这个command是关键
(command "w" 0 570 "a")
(if (= FriFlags 0)
(progn
(command "a" -120)
(setq FriFlags 1)
)
(progn
(command -120)
(setq FriFlags (1+ FriFlags))
)
)
) ;foreach
(command (car AllXyList) "");如此才能结束pline
(setvar "osmode" oldos)
)
感谢分享，一步到位，不用先画矩形再转运行了 厉害了还没下载 下载来看看 南方CASS里有动态画云线，更完美 楼主有心了，不过有个更加简单的画这种云线的方法，先用LISP 生成一个矩形，再把矩形转换成云线，几句话就搞定了，运行起来也更快。 LIFEI18 发表于 2011-1-28 18:33 static/image/common/back.gif
楼主有心了，不过有个更加简单的画这种云线的方法，先用LISP 生成一个矩形，再把矩形转换成云线，几句话就搞 ...
这位兄弟的方法我倒不会，可否告诉下操作过程？其实我编这个程序主要是因为那天突然发现pline和command可以如此奇妙的组合使用，甚至其他的cad命令也可以有这种灵活的调用方法，于是就找几段代码凑了这个程序。
现在基本上不再画图了，挺怀念的，呵呵。 使用COMMAND函数掉用CAD本身画云线命令，将最后生成的对象转换成云线,就行了，
(command "_.rectang" pt1 pt2 "")
（command "_.revcloud" "o" (entlast) "n" ""） 太强了！ 太强了！ 不错的东西。 谢谢大师们！ 感谢楼主分享! 虽然用到的不多，感谢分享！~~