框选画云线程序

yucpp

;;此云线使用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)
)

szhorse

感谢分享，一步到位，不用先画矩形再转运行了

yoyrtweq

厉害了  还没下载 下载来看看

香远益清

南方CASS里有动态画云线，更完美

LIFEI18

楼主有心了，不过有个更加简单的画这种云线的方法，先用LISP 生成一个矩形，再把矩形转换成云线，几句话就搞定了，运行起来也更快。

yucpp

LIFEI18 发表于 2011-1-28 18:33
楼主有心了，不过有个更加简单的画这种云线的方法，先用LISP 生成一个矩形，再把矩形转换成云线，几句话就搞 ...

这位兄弟的方法我倒不会，可否告诉下操作过程？其实我编这个程序主要是因为那天突然发现pline和command可以如此奇妙的组合使用，甚至其他的cad命令也可以有这种灵活的调用方法，于是就找几段代码凑了这个程序。
现在基本上不再画图了，挺怀念的，呵呵。

LIFEI18

使用COMMAND函数掉用CAD本身画云线命令，将最后生成的对象转换成云线,就行了，

(command "_.rectang" pt1 pt2 "")
（command "_.revcloud" "o" (entlast) "n" ""）

pop159

太强了！

pop159

太强了！

风流少年时

不错的东西。

669423907

谢谢大师们！

yoyoho

感谢楼主分享!

daidong013

虽然用到的不多，感谢分享！~~