[请指教]我前段时间编写其它程序时建立的自用函数！

似水无痕 · 发表于 2005-11-10 13:04:42

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[FONT=courier new]
;;;********************************;;;
;;;---------三维点相加程序---------;;;
;;;********************************;;;
(defun 3dpoint_add (point1 point2 / x1 y1 z1 x2 y2 z2 finalpoint)
(if (= (length point1) 3)
(if (= (length point2) 3)
(progn
(setq x1 (car point1)
y1 (cadr point1)
z1 (caddr point1)
x2 (car point2)
y2 (cadr point2)
z2 (caddr point2)
)
(setq finalpoint (list (+ x1 x2) (+ y1 y2) (+ z1 z2)))
)
(princ "\n第二点不是三维点")
)
(princ "\n第一点不是三维点")
)
finalpoint
)
;;;********************************;;;
;;;-----三维点相减程序(p1-p2)------;;;
;;;********************************;;;
(defun 3dpoint_subtract (point1 point2 / x1 y1 z1 x2 y2 z2 finalpoint)
(if (= (length point1) 3)
(if (= (length point2) 3)
(progn
(setq x1 (car point1)
y1 (cadr point1)
z1 (caddr point1)
x2 (- 0.0 (car point2))
y2 (- 0.0 (cadr point2))
z2 (- 0.0 (caddr point2))
)
(setq finalpoint (list (+ x1 x2) (+ y1 y2) (+ z1 z2)))
)
(princ "\n第二点不是三维点")
)
(princ "\n第一点不是三维点")
)
finalpoint
)
;;;********************************;;;
;;;-三维点乘以常量3dpoint_multiply-;;;
;;;********************************;;;
(defun 3dpoint_multiply (point1 multiple / x1 y1 z1 finalpoint)
(if (= (length point1) 3)
(progn
(setq x1 (car point1)
y1 (cadr point1)
z1 (caddr point1)
)
(setq finalpoint
(list (* x1 multiple)
(* y1 multiple)
(* z1 multiple)
)
)
)
(princ "\n第一点不是三维点")
)
finalpoint
)
;;;**********************************;;;
;;;提取三维点的x、y坐标并置换为二维点;;;
;;;**********************************;;;
(defun 3d->2d_xy (point1 / x1 y1 finalpoint)
(if (= (length point1) 3)
(progn
(setq x1 (car point1)
y1 (cadr point1)
)
(setq finalpoint (list x1 y1 0.0))
)
(princ "\n该点不是三维点")
)
finalpoint
)
;;;**********************************;;;
;;;-该函数将获得两条线段的交点并输出-;;;
;;;**********************************;;;
(defun 2line_crossing (p1 p2 p3 p4 / x y x1 y1 x2 y2 x3 y3 x4 y4 k1 k2
b1 b2)
(setq x1 (car p1)
y1 (cadr p1)
x2 (car p2)
y2 (cadr p2)
x3 (car p3)
y3 (cadr p3)
x4 (car p4)
y4 (cadr p4)
)
(if (and (= x2 x1) (= x3 x4))
(alert "两条平行线--不相交")
)
(if (and (= x2 x1) (/= x4 x3))
(setq x x1
y (- y3 (/ (* (- x1 x3) (- y3 y4)) (- x4 x3)))
)
)
(if (and (/= x2 x1) (= x4 x3))
(setq x x3
y (- y1 (/ (* (- x3 x1) (- y1 y2)) (- x2 x1)))
)
)
(if (and (/= x2 x1) (/= x3 x4))
(setq k1 (/ (- y2 y1) (- x2 x1))
b1 (- y1 (* k1 x1))
k2 (/ (- y4 y3) (- x4 x3))
b2 (- y3 (* k2 x3))
)
)
(if (/= k1 nil)
(if (> (- k1 k2) 0.000001)
(setq x (/ (- b2 b1) (- k1 k2))
y (+ b1 (* k1 x))
)
(alert "两条平行线--不相交")
)
)
(list x y 0.0)
)
;;;**********************************;;;
;;;-角度值转换为弧度函数jiaodu->hudu-;;;
;;;**********************************;;;
(defun jiaodu->hudu (jiaodu / hudu)
(setq hudu (* pi (/ jiaodu 180.0)))
hudu
)
;;;**********************************;;;
;;;-弧度值转换为角度函数hudu->jiaodu-;;;
;;;**********************************;;;
(defun hudu->jiaodu (hudu / jiaodu)
(setq jiaodu (* 180.0 (/ hudu pi)))
jiaodu
)
;;;**********************************;;;
;;;-----------正切值函数tan----------;;;
;;;**********************************;;;
(defun tan (jiaodu)
(/ (sin jiaodu) (cos jiaodu))
)
;;;**********************************;;;
;;;-----------余切值函数ctan----------;;;
;;;**********************************;;;
(defun ctan (hudu)
(/ (cos hudu) (sin hudu))
)
;;;********************;;;
;;;--创建“主体”图层--;;;
;;;********************;;;
(defun layer_zhuti ()
(if (= (tblobjname "LAYER" "主体") nil)
(progn
(setq x (entmake (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
'(6 . "CONTINUOUS") ;线型
'(62 . 7) ;颜色
'(70 . 0) ;图层状态
(cons 2 "主体") ;图层名
)
)
)
)
)
(setvar "clayer" "主体")
)
[/FONT]

[FONT=courier new] 
;;;********************************;;; 
;;;---------三维点相加程序---------;;; 
;;;********************************;;; 
 
(defun 3dpoint_add (point1 point2 / x1 y1 z1 x2 y2 z2 finalpoint) 
  (if (= (length point1) 3) 
    (if        (= (length point2) 3) 
      (progn 
        (setq x1 (car point1) 
              y1 (cadr point1) 
              z1 (caddr point1) 
              x2 (car point2) 
              y2 (cadr point2) 
              z2 (caddr point2) 
        ) 
        (setq finalpoint (list (+ x1 x2) (+ y1 y2) (+ z1 z2))) 
      ) 
      (princ "\n第二点不是三维点") 
    ) 
    (princ "\n第一点不是三维点") 
  ) 
  finalpoint 
) 
 
 
;;;********************************;;; 
;;;-----三维点相减程序(p1-p2)------;;; 
;;;********************************;;; 
 
(defun 3dpoint_subtract        (point1 point2 / x1 y1 z1 x2 y2 z2 finalpoint) 
  (if (= (length point1) 3) 
    (if        (= (length point2) 3) 
      (progn 
        (setq x1 (car point1) 
              y1 (cadr point1) 
              z1 (caddr point1) 
              x2 (- 0.0 (car point2)) 
              y2 (- 0.0 (cadr point2)) 
              z2 (- 0.0 (caddr point2)) 
        ) 
        (setq finalpoint (list (+ x1 x2) (+ y1 y2) (+ z1 z2))) 
      ) 
      (princ "\n第二点不是三维点") 
    ) 
    (princ "\n第一点不是三维点") 
  ) 
  finalpoint 
) 
 
;;;********************************;;; 
;;;-三维点乘以常量3dpoint_multiply-;;; 
;;;********************************;;; 
 
(defun 3dpoint_multiply        (point1 multiple / x1 y1 z1 finalpoint) 
  (if (= (length point1) 3) 
    (progn 
      (setq x1 (car point1) 
            y1 (cadr point1) 
            z1 (caddr point1) 
      ) 
      (setq finalpoint 
             (list (* x1 multiple) 
                   (* y1 multiple) 
                   (* z1 multiple) 
             ) 
      ) 
    ) 
    (princ "\n第一点不是三维点") 
  ) 
  finalpoint 
) 
;;;**********************************;;; 
;;;提取三维点的x、y坐标并置换为二维点;;; 
;;;**********************************;;; 
 
(defun 3d->2d_xy (point1 / x1 y1 finalpoint) 
  (if (= (length point1) 3) 
    (progn 
      (setq x1 (car point1) 
            y1 (cadr point1) 
      ) 
      (setq finalpoint (list x1 y1 0.0)) 
    ) 
    (princ "\n该点不是三维点") 
  ) 
  finalpoint 
) 
;;;**********************************;;; 
;;;-该函数将获得两条线段的交点并输出-;;; 
;;;**********************************;;; 
 
(defun 2line_crossing (p1 p2 p3        p4 / x y x1 y1 x2 y2 x3        y3 x4 y4 k1 k2 
                       b1 b2) 
  (setq        x1 (car p1) 
        y1 (cadr p1) 
        x2 (car p2) 
        y2 (cadr p2) 
        x3 (car p3) 
        y3 (cadr p3) 
        x4 (car p4) 
        y4 (cadr p4) 
  ) 
  (if (and (= x2 x1) (= x3 x4)) 
    (alert "两条平行线--不相交") 
  ) 
  (if (and (= x2 x1) (/= x4 x3)) 
    (setq x x1 
          y (- y3 (/ (* (- x1 x3) (- y3 y4)) (- x4 x3))) 
    ) 
  ) 
  (if (and (/= x2 x1) (= x4 x3)) 
    (setq x x3 
          y (- y1 (/ (* (- x3 x1) (- y1 y2)) (- x2 x1))) 
    ) 
  ) 
  (if (and (/= x2 x1) (/= x3 x4)) 
    (setq k1 (/ (- y2 y1) (- x2 x1)) 
          b1 (- y1 (* k1 x1)) 
          k2 (/ (- y4 y3) (- x4 x3)) 
          b2 (- y3 (* k2 x3)) 
    ) 
  ) 
  (if (/= k1 nil) 
    (if        (> (- k1 k2) 0.000001) 
      (setq x (/ (- b2 b1) (- k1 k2)) 
            y (+ b1 (* k1 x)) 
      ) 
      (alert "两条平行线--不相交") 
    ) 
  ) 
  (list x y 0.0) 
) 
;;;**********************************;;; 
;;;-角度值转换为弧度函数jiaodu->hudu-;;; 
;;;**********************************;;; 
 
(defun jiaodu->hudu (jiaodu / hudu) 
  (setq hudu (* pi (/ jiaodu 180.0))) 
  hudu 
) 
 
 
;;;**********************************;;; 
;;;-弧度值转换为角度函数hudu->jiaodu-;;; 
;;;**********************************;;; 
 
(defun hudu->jiaodu (hudu / jiaodu) 
  (setq jiaodu (* 180.0 (/ hudu pi))) 
  jiaodu 
) 
 
 
;;;**********************************;;; 
;;;-----------正切值函数tan----------;;; 
;;;**********************************;;; 
 
(defun tan (jiaodu) 
  (/ (sin jiaodu) (cos jiaodu)) 
) 
 
;;;**********************************;;; 
;;;-----------余切值函数ctan----------;;; 
;;;**********************************;;; 
 
(defun ctan (hudu) 
  (/ (cos hudu) (sin hudu)) 
) 
;;;********************;;; 
;;;--创建“主体”图层--;;; 
;;;********************;;; 
 
(defun layer_zhuti () 
  (if (= (tblobjname "LAYER" "主体") nil) 
    (progn 
      (setq x (entmake (list 
                         '(0 . "LAYER") 
                         '(100 . "AcDbSymbolTableRecord") 
                         '(100 . "AcDbLayerTableRecord") 
                         '(6 . "CONTINUOUS") ;线型 
                         '(62 . 7)        ;颜色 
                         '(70 . 0)        ;图层状态 
                         (cons 2 "主体") ;图层名 
                       ) 
              ) 
      ) 
    ) 
  ) 
  (setvar "clayer" "主体") 
) 
 
  [/FONT]

eachy · 发表于 2005-11-10 15:32:49

建议你到这里看看
http://www.xdcad.net/forum/forumdisplay.php?s=&forumid=50

似水无痕 · 发表于 2005-11-10 17:10:12

谢谢谢谢，我本来没有打算得到什么爱心币，更加不敢奢望积分，只是想拿过来分享一下，以便大家提出一点意见和建议而已！一不小心竟而得了一分，看来今天得喝酒庆祝一下了！
再次感谢eachy斑竹！

xyp1964 · 发表于 2005-11-10 17:38:22

恭喜了！eachy斑竹对你不错！
东西不错，继续努力。

疑问：
1、三维点的操作用于何处？
2、2line_crossing （两条线段的交点并输出）里并没有线段

wkai · 发表于 2005-11-10 18:46:36

;;op 运算符
;;p1 点表
;;p2 点表
(defun 3dPointOperate(op p1 p2)
(mapcar op p1 p2)
)
;;示例
(setq a '(12.0 12.0 12.0))(setq b '(15 12 6))
(print(3dPointOperate '+ a b))
(print(3dPointOperate '- a b))
(print(3dPointOperate '* a b))
(print(3dPointOperate '/ a b))

似水无痕 · 发表于 2005-11-10 19:24:33

最初由 xyp1964 发布
[B]恭喜了！eachy斑竹对你不错！
东西不错，继续努力。

疑问：
1、三维点的操作用于何处？
2、2line_crossing （两条线段的交点并输出）里并没有线段 [/B]

谢谢xyp1964 斑竹！
三维点操作是我在主程序里经常用到，因为在编程中经常要用到插入点，各特征点都随插入点变化，所以编写了一个函数！
三维点乘以常量是因为我在计算时以m为单位，有时要出以cm为单位的图比较不方便，所以该常量为出图比例因子（好像有点罗嗦吧，呵呵！）
2line_crossing是point1－point2，point3－point4分别表示两条直线，在主程序中因为都是用点组成的数据列表，所以求两条线段交点较为方便！
我的主程可能有点麻烦，都是自己瞎咂摸出来的一些，但是有些思路可以和大家互相交流一下！

也非常感谢wkai斑竹，你的程序确实简洁明了，比我的好用多了！
谢谢各位，向你们学习！

狂刀 · 发表于 2005-11-10 20:47:56

没细看，好像把简单问题复杂化了

似水无痕 · 发表于 2005-11-10 20:53:19

最初由狂刀发布
[B]没细看，好像把简单问题复杂化了 [/B]

是有点，刚刚才学习么！还希望狂兄多多指教，谢谢！

eachy · 发表于 2005-11-11 02:57:36

线交点 -〉(inters p1 p2 p3 p4) or (inters p1 p2 p3 p4 nil)

WHGF · 发表于 2005-11-11 08:16:31

三维点操作在GIS数据中还是有意义的，如三维数据的调平处理！

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

[请指教]我前段时间编写其它程序时建立的自用函数！

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子