[编程申请]："跑道形状" 画图命令

eachy · 发表于 2003-10-3 21:34:37

再加个Rotate命令能满足要求吗？

lsjjm · 发表于 2003-10-4 05:56:21

最初由 eachy 发布
[B]再加个Rotate命令能满足要求吗？ [/B]

不是不可以.
我的初衷可能大家还没高清楚: 画一个任意角度的"跑道形"(实际上就是矩形倒一个半径等于上下对边距离一半的圆角), .
这个操作, 稍懂得一些CAD知识的人都会画. 一步一步来呗. 但我的目的是自定义一个命令(编一个小程序)把这些操作步骤更简捷, 方便. 其操作状态和"感觉"就象画椭圆一样. 诸位说的方法, 我不是没试过, 但至今都不太理想.

陌生人 · 发表于 2003-10-7 03:50:36

画椭圆也至少要点3下，加旋转要点4下，快不到哪里去啊，编程通过长短轴来定义，方法也是差不多的，只是参照点转换一下而已。
不同的想来只是动态显示而已，这个编程也不难做到，加一段就可以。

lsjjm · 发表于 2003-10-7 04:57:52

最初由陌生人发布
[B]画椭圆也至少要点3下，加旋转要点4下，快不到哪里去啊，编程通过长短轴来定义，方法也是差不多的，只是参照点转换一下而已。
不同的想来只是动态显示而已，这个编程也不难做到，加一段就可以。 [/B]

那你就"加一段"吧?!

陌生人 · 发表于 2003-10-7 09:15:01

1 看你前面的帖子，估计你也有一定的编程水平，这个对你来说应该不难的，是不是懒啦？：）

陌生人 · 发表于 2003-10-11 21:08:57

嘿嘿

lsjjm · 发表于 2003-10-12 08:41:36

对不起, 看不了RAR文件. 892K 也不大, 能否直接贴出来? 谢谢!

eachy · 发表于 2003-10-12 11:55:45

编译的fas不能直接贴出的，Lisp源码的话本想给加分的^_^

陌生人 · 发表于 2003-10-13 13:59:35

加分有什么好处？能用来赌么？

eachy · 发表于 2003-10-13 14:29:19

最初由陌生人发布
[B]加分有什么好处？能用来赌么？ [/B]

加积分。

七丰 · 发表于 2003-10-13 17:26:03

我觉得不要把问题复杂化了。

forxiu · 发表于 2003-10-13 20:55:13

我是新来的，长见识

aeo · 发表于 2003-10-13 22:05:38

最初由 eachy 发布
[B]编译的fas不能直接贴出的，Lisp源码的话本想给加分的^_^ [/B]

分和币都要 :)

;;;
;;;很象画"椭圆".
;;;需要xd_api
;;;命令名称 aeo
;;;Esc和右键退出，其他键和左键确认.

(defun c:aeo (/ ang box dis dis1 ent p1 p2 p3 w box-p1 make-pl myerr old)
(defun box-p1 (dis dis1 / box h p w x y)
(setq w (/ (abs (- dis dis1)) 2.)
h (/ (min dis dis1 ) 2.)
p (xdrx_midp p1 p2)
x (car p)
y (cadr p)
box (list (list (- x w) (- y h)) (list (+ x w) (- y h))
(list (+ x w) (+ y h)) (list (- x w) (+ y h))
)
)
(apply
'xdrx_pointsrotate
(cons p (cons (if (> dis dis1)
ang
(+ ang (* 0.5 pi))
) box
)
)
)
)
(defun make-pl (box)
(setq box (mapcar
'(lambda (x)
(cons 10 (list (car x) (cadr x)))
)
box
)
)
(entmake (append
(list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '
(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
)
box
)
)
(entlast)
)
(defun myerr (msg)
(if ent
(entdel ent)
)
(xdrx_end)
(princ)
)
;;; main
(xdrx_begin)
(setq old *error*
*error* myerr
)
(if (and
(setq p1 (getpoint "\nFirst:"))
(setq p2 (getpoint p1 "--Next:"))
(setq ang (angle p1 p2)
dis (distance p1 p2)
w t
)
)
(while w
(setq p3 (grread t 10))
(cond
((= (car p3) 5)
(setq dis1 (* 2 (abs (xdrx_p2ldist (cadr p3) p1 p2))))
(setq box (box-p1 dis dis1))
(if (not ent)
(setq ent (make-pl box))
)
(mapcar
'(lambda (x y)
(xdrx_polyline_setPointAt ent x y)
)
'(0 1 2 3)
box
)
(mapcar
'(lambda (x y)
(xdrx_polyline_setBulgeAt ent x y)
)
'(0 1 2 3)
'(0. 1. 0. 1.)
)
)
((= (car p3) 11)
(if ent
(entdel ent)
)
(setq w nil)
)
((member (car p3) '(3 2))
(setq w nil)
)
(t
)
)
)
)
(setq *error* old)
(xdrx_end)
(princ)
)

(defun c:aeo (/ ang box dis dis1 ent p1 p2 p3 w box-p1 make-pl myerr old) 
  (defun box-p1 (dis dis1 / box h p w x y) 
    (setq w (/ (abs (- dis dis1)) 2.) 
          h (/ (min dis dis1 ) 2.) 
          p (xdrx_midp p1 p2) 
          x (car p) 
          y (cadr p) 
          box (list (list (- x w) (- y h)) (list (+ x w) (- y h)) 
                    (list (+ x w) (+ y h)) (list (- x w) (+ y h)) 
              ) 
    ) 
    (apply 
      'xdrx_pointsrotate 
      (cons p (cons (if (> dis dis1) 
                      ang 
                      (+ ang (* 0.5 pi)) 
                    ) box 
              ) 
      ) 
    ) 
  ) 
  (defun make-pl (box) 
    (setq box (mapcar 
                '(lambda (x) 
                   (cons 10 (list (car x) (cadr x))) 
                 ) 
                box 
              ) 
    ) 
    (entmake (append 
               (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") ' 
                     (100 . "AcDbPolyline") '(90 . 4) '(70 . 1) 
               ) 
               box 
             ) 
    ) 
    (entlast) 
  ) 
  (defun myerr (msg) 
    (if ent 
      (entdel ent) 
    ) 
    (xdrx_end) 
    (princ) 
  )                                        
;;; main 
  (xdrx_begin) 
  (setq old *error* 
        *error* myerr 
  ) 
  (if (and 
        (setq p1 (getpoint "\nFirst:")) 
        (setq p2 (getpoint p1 "--Next:")) 
        (setq ang (angle p1 p2) 
              dis (distance p1 p2) 
              w t 
        ) 
      ) 
    (while w 
      (setq p3 (grread t 10)) 
      (cond 
        ((= (car p3) 5) 
          (setq dis1 (* 2 (abs (xdrx_p2ldist (cadr p3) p1 p2)))) 
          (setq box (box-p1 dis dis1)) 
          (if (not ent) 
            (setq ent (make-pl box)) 
          ) 
          (mapcar 
            '(lambda (x y) 
               (xdrx_polyline_setPointAt ent x y) 
             ) 
            '(0 1 2 3) 
            box 
          ) 
          (mapcar 
            '(lambda (x y) 
               (xdrx_polyline_setBulgeAt ent x y) 
             ) 
            '(0 1 2 3) 
            '(0. 1. 0. 1.) 
          ) 
        ) 
        ((= (car p3) 11) 
          (if ent 
            (entdel ent) 
          ) 
          (setq w nil) 
        ) 
        ((member (car p3) '(3 2)) 
          (setq w nil) 
        ) 
        (t 
        ) 
      ) 
    ) 
  ) 
  (setq *error* old) 
  (xdrx_end) 
  (princ) 
)

陌生人 · 发表于 2003-10-13 22:44:05

哈哈，好样的。氛围有些热烈起来了哦：）
不过说到效果，你的“肯定比上面演示的好,自己就不做了”我可不敢苟同，但是我也不会说一定比你的好。大家作图过程都是点3个点，虽然你的更接近椭圆画法，但是我的其实也是，只是在画长度轴的时候同时控制角度和长度，而你的角度是通过短轴来确定。我是按照自己喜欢并觉得合理的方式作图，至于别人用起来怎么样，要看他们的习惯了。

另外，我理解发问者的要求，他是要一个视图，我的也做到了。你的只是画了跑道，还没做视图处理呢。
程序的最末，本来还有对画出椭圆的长度，面积统计，但是因为是视图，这个部分在修改的时候去掉了。

交流交流看法，别把胜负看的太重哦：）

aeo · 发表于 2003-10-14 00:22:42

最初由陌生人发布
[B]哈哈，好样的。氛围有些热烈起来了哦：）
不过说到效果，你的“肯定比上面演示的好,自己就不做了”我可不敢苟同，但是我也不会说一定比你的好。大家作图过程都是点3个点，虽然你的更接近椭圆画法，但是我的其实也是... [/B]

他要的是引祥图，当然只要画个线.

画椭圆时是没长短轴之分的.拽过头了，长轴就变为短轴.

你的要精确的框出一块来，麻烦.
我只要求你画一个平放或竖放着的框出来.

账号		自动登录	找回密码
密码			立即注册

[编程申请]："跑道形状" 画图命令

浏览过的版块