快速改变夹角

lucas_3333 · 发表于 2014-6-20 19:35:16

我有一个关于直线快速旋转（改变夹角）的想法，用lisp完成行么？就是两条直线，相交的，运行命令后，选择第一条直线（固定不动的），选择第二条直线（需要旋转的），然后显示：当前角度为xx度，请输入新角度，输入新角度后，就让第二条直线绕交点旋转使两线的角度等于输入的角度.

edata · 发表于 2014-6-20 19:35:17

;;取组码值
(defun sk_dxf(ent code)(cdr(assoc code(entget ent))))
;;选择函数
(defun sk_sel01(str filter / ent loop)
(setq loop t
str (if (= (type str) 'STR) str "")
filter(if (= (type filter) 'LIST) (mapcar 'strcase filter) nil)
)
(while loop
(if(setq ent(entsel str))
(if (member (strcase (sk_dxf (car ent) 0)) filter)
(setq loop nil)
)
(setq loop nil)
)
)
(if ent ent)
)
;;取拾取点附近直线或轻多段线两端点
(defun sk_nearest(ent / en end_pt index index+ lst obj p0 p1 p3 p4)
(setq en(car ent)
p0(cadr ent)
)
(cond
((= (sk_dxf en 0) "LINE")
(setq p1(vlax-curve-getClosestPointTo en p0))
(setq lst(list en p1 (sk_dxf en 10)(sk_dxf en 11)))
)
((= (sk_dxf en 0) "LWPOLYLINE")
(setq p1(vlax-curve-getClosestPointTo en p0)
obj(vlax-ename->vla-object en)
end_pt(sk_dxf en 90)
index(fix(vlax-curve-getParamAtPoint obj p1))
p3(vlax-curve-getPointAtParam obj index)
index+(1+ index)
)
(if (and (=(sk_dxf en 70) 1)(> index+ end_pt))
(setq p4 (vlax-curve-getPointAtParam obj 0))
(setq p4 (vlax-curve-getPointAtParam obj index+))
)
(vlax-release-object obj)
(setq lst(list en p1 p3 p4))
)
)
)
;;;两线角度函数
;;;Two line angle
;;<a href=\"http://bbs.mjtd.com/forum.php?mod=viewthread&tid=16602&page=1&authorid=250774\" target=\"_blank\">http://bbs.mjtd.com/forum.php?mo ... amp;authorid=250774</a>
;;code by qjchen
(defun q:geo:2line:ang2(p1 p2 p3 p4)
((lambda(x) (atan (sqrt (abs (- 1.0 (* x x)))) x))
(/ (apply '+ (mapcar '* (mapcar '- p2 p1) (mapcar '- p4 p3))) (distance p1 p2) (distance p3 p4))
)
)
;;三点判断顺逆时针
;;http://bbs.mjtd.com/forum.php?mo ... &authorid=43121
;;copy by edata@mjtd
(defun sk_ang_3pt(p1 p2 p3 / a b c d p1x p1y p2x p2y p3x p3y)
(setq p1x(car p1)
p1y(cadr p1)
p2x(car p2)
p2y(cadr p2)
p3x(car p3)
p3y(cadr p3)
)
(setq a(- p3y p1y)
b(- p1x p3x)
c(-(* -1.0 a p1x)(* b p1y))
d(-(* -1.0 a p2x)(* b p2y))
)
(cond
((= d c)0)
((> d c)-1)
(t 1)
)
)
;;主程序
(defun c:tt(/ ang1 ang2 ang3 ang4 en2 ent1 ent2 ipt lst1 lst2 obj2 p1 p2 p3 p4 pt1 pt2 px1 px2 x y)
(if(and (setq ent1(sk_sel01 "\n选择第一条线" '("line" "lwpolyline")))
(list (redraw (car ent1) 3))
(setq ent2(sk_sel01 "\n选择第二条线" '("line" "lwpolyline")))
(list (redraw (car ent2) 3))
)
(progn
(setq lst1(sk_nearest ent1)
lst2(sk_nearest ent2)
)
(mapcar '(lambda(x y)(set (read x) y))(List "en1" "pt1" "p1" "p2")lst1)
(mapcar '(lambda(x y)(set (read x) y))(List "en2" "pt2" "p3" "p4")lst2)
(if(and pt1 pt2 p1 p2 p3 p4 (setq ipt(inters p1 p2 p3 p4 nil)))
(progn
(setq ang1(angle ipt pt1)
px1(polar ipt ang1 1)
ang2(angle ipt pt2)
px2(polar ipt ang2 1)
ang3(q:geo:2line:ang2 ipt px1 ipt px2)
obj2(vlax-ename->vla-object en2)
)
(if (setq ang4(getangle (strcat "\n输入新的角度<当前:"(angtos ang3 0 4)">:" )))
(vla-Rotate obj2 (vlax-3d-point ipt) (if(=(sk_ang_3pt ipt px1 px2)1)(- ang4 ang3)(- ang3 ang4) ))
)
(vlax-release-object obj2)
)
(prompt "\n确认两条线是否有交点.")
)
)
)
(and ent1(redraw (car ent1) 4))
(and ent2(redraw (car ent2) 4))
(princ)
)

;;取组码值 
(defun sk_dxf(ent code)(cdr(assoc code(entget ent)))) 
;;选择函数 
(defun sk_sel01(str filter / ent loop) 
  (setq loop t 
        str (if (= (type str) 'STR) str "") 
        filter(if (= (type filter) 'LIST) (mapcar 'strcase filter)  nil) 
        )         
  (while loop 
    (if(setq ent(entsel str)) 
      (if (member (strcase (sk_dxf (car ent) 0)) filter) 
      (setq loop nil) 
      ) 
      (setq loop nil) 
    ) 
    ) 
  (if ent ent) 
  ) 
;;取拾取点附近直线或轻多段线两端点 
(defun sk_nearest(ent / en end_pt index index+ lst obj p0 p1 p3 p4) 
  (setq en(car ent) 
        p0(cadr ent) 
        ) 
  (cond 
    ((= (sk_dxf en 0) "LINE") 
     (setq p1(vlax-curve-getClosestPointTo en p0)) 
     (setq lst(list en p1 (sk_dxf en 10)(sk_dxf en 11))) 
     ) 
    ((= (sk_dxf en 0) "LWPOLYLINE") 
     (setq p1(vlax-curve-getClosestPointTo en p0) 
           obj(vlax-ename->vla-object en) 
           end_pt(sk_dxf en 90) 
           index(fix(vlax-curve-getParamAtPoint obj p1)) 
           p3(vlax-curve-getPointAtParam obj index) 
           index+(1+ index) 
           ) 
     (if (and (=(sk_dxf en 70) 1)(> index+ end_pt)) 
       (setq p4 (vlax-curve-getPointAtParam obj 0)) 
       (setq p4 (vlax-curve-getPointAtParam obj index+))               
       ) 
     (vlax-release-object obj) 
     (setq lst(list en p1 p3 p4))      
     ) 
    ) 
  ) 
;;;两线角度函数 
;;;Two line angle 
;;<a href=\"http://bbs.mjtd.com/forum.php?mod=viewthread&tid=16602&page=1&authorid=250774\" target=\"_blank\">http://bbs.mjtd.com/forum.php?mo ... amp;authorid=250774</a> 
;;code by qjchen 
(defun q:geo:2line:ang2(p1 p2 p3 p4) 
  ((lambda(x) (atan (sqrt (abs (- 1.0 (* x x)))) x)) 
     (/ (apply '+ (mapcar '* (mapcar '- p2 p1) (mapcar '- p4 p3))) (distance p1 p2) (distance p3 p4)) 
  ) 
) 
;;三点判断顺逆时针 
;;<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=110172&page=1&authorid=43121" target="_blank">http://bbs.mjtd.com/forum.php?mo ... &authorid=43121</a> 
;;copy by edata@mjtd 
(defun sk_ang_3pt(p1 p2 p3 / a b c d p1x p1y p2x p2y p3x p3y) 
  (setq p1x(car p1) 
        p1y(cadr p1) 
        p2x(car p2) 
        p2y(cadr p2) 
        p3x(car p3) 
        p3y(cadr p3) 
        ) 
  (setq a(- p3y p1y) 
        b(- p1x p3x) 
        c(-(* -1.0 a p1x)(* b p1y)) 
        d(-(* -1.0 a p2x)(* b p2y)) 
        ) 
  (cond 
    ((= d c)0)      
    ((> d c)-1) 
    (t 1) 
    ) 
  ) 
 
;;主程序 
(defun c:tt(/ ang1 ang2 ang3 ang4 en2 ent1 ent2 ipt lst1 lst2 obj2 p1 p2 p3 p4 pt1 pt2 px1 px2 x y) 
  (if(and (setq ent1(sk_sel01 "\n选择第一条线" '("line" "lwpolyline"))) 
          (list (redraw (car ent1) 3)) 
          (setq ent2(sk_sel01 "\n选择第二条线" '("line" "lwpolyline"))) 
          (list (redraw (car ent2) 3)) 
          ) 
    (progn 
      (setq lst1(sk_nearest ent1) 
            lst2(sk_nearest ent2) 
            ) 
      (mapcar '(lambda(x y)(set (read x) y))(List "en1" "pt1" "p1" "p2")lst1) 
      (mapcar '(lambda(x y)(set (read x) y))(List "en2" "pt2" "p3" "p4")lst2) 
      (if(and pt1 pt2 p1 p2 p3 p4 (setq ipt(inters p1 p2 p3 p4 nil))) 
        (progn 
          (setq ang1(angle ipt pt1) 
                px1(polar ipt ang1 1) 
                ang2(angle ipt pt2) 
                px2(polar ipt ang2 1)                
                ang3(q:geo:2line:ang2 ipt px1 ipt px2) 
                obj2(vlax-ename->vla-object en2) 
                ) 
          (if (setq ang4(getangle (strcat "\n输入新的角度<当前:"(angtos ang3 0 4)">:" ))) 
            (vla-Rotate obj2 (vlax-3d-point ipt) (if(=(sk_ang_3pt ipt px1 px2)1)(- ang4 ang3)(- ang3 ang4) )) 
            ) 
          (vlax-release-object obj2) 
          ) 
        (prompt "\n确认两条线是否有交点.") 
        )       
      )    
    ) 
  (and ent1(redraw (car ent1) 4)) 
  (and ent2(redraw (car ent2) 4)) 
  (princ) 
  )

edata · 发表于 2014-6-20 19:49:16

仅仅是直线？

lucas_3333 · 发表于 2014-6-20 19:54:45

本帖最后由 lucas_3333 于 2014-6-20 19:57 编辑

edata 发表于 2014-6-20 19:49
仅仅是直线？

如果加上ＰＬ线，行吗？如果算上ＰＬ线，那也只能是针对两个点的PL线吧

edata · 发表于 2014-6-20 19:59:30

都是可以的。
直线边，无凸度。

lucas_3333 · 发表于 2014-6-20 20:05:07

edata 发表于 2014-6-20 19:59
都是可以的。
直线边，无凸度。

嗯，那样更好，谢谢e大

edata · 发表于 2014-6-20 23:18:18

----------------

;;取组码值
(defun sk_dxf(ent code)(cdr(assoc code(entget ent))))
;;选择函数
(defun sk_sel01(str filter / ent loop)
(setq loop t
str (if (= (type str) 'STR) str "")
filter(if (= (type filter) 'LIST) (mapcar 'strcase filter) nil)
)
(while loop
(if(setq ent(entsel str))
(if (member (strcase (sk_dxf (car ent) 0)) filter)
(setq loop nil)
)
(setq loop nil)
)
)
(if ent ent)
)
;;取拾取点附近直线或轻多段线两端点
(defun sk_nearest(ent / en end_pt index index+ lst obj p0 p1 p3 p4)
(setq en(car ent)
p0(cadr ent)
)
(cond
((= (sk_dxf en 0) "LINE")
(setq p1(vlax-curve-getClosestPointTo en p0))
(setq lst(list en p1 (sk_dxf en 10)(sk_dxf en 11)))
)
((= (sk_dxf en 0) "LWPOLYLINE")
(setq p1(vlax-curve-getClosestPointTo en p0)
obj(vlax-ename->vla-object en)
end_pt(sk_dxf en 90)
index(fix(vlax-curve-getParamAtPoint obj p1))
p3(vlax-curve-getPointAtParam obj index)
index+(1+ index)
)
(if (and (=(sk_dxf en 70) 1)(> index+ end_pt))
(setq p4 (vlax-curve-getPointAtParam obj 0))
(setq p4 (vlax-curve-getPointAtParam obj index+))
)
(vlax-release-object obj)
(setq lst(list en p1 p3 p4))
)
)
)
;;;两线角度函数
;;;Two line angle
;;http://bbs.mjtd.com/forum.php?mo ... amp;authorid=250774
;;code by qjchen
(defun q:geo:2line:ang2(p1 p2 p3 p4)
((lambda(x) (atan (sqrt (abs (- 1.0 (* x x)))) x))
(/ (apply '+ (mapcar '* (mapcar '- p2 p1) (mapcar '- p4 p3))) (distance p1 p2) (distance p3 p4))
)
)
;;主程序
(defun c:tt(/ ang1 ang2 ang3 ang4 en2 ent1 ent2 ipt lst1 lst2 obj2 p1 p2 p3 p4 pt1 pt2 px1 px2 x y)
(if(and (setq ent1(sk_sel01 "\n选择第一条线" '("line" "lwpolyline")))
(list (redraw (car ent1) 3))
(setq ent2(sk_sel01 "\n选择第二条线" '("line" "lwpolyline")))
(list (redraw (car ent2) 3))
)
(progn
(setq lst1(sk_nearest ent1)
lst2(sk_nearest ent2)
)
(mapcar '(lambda(x y)(set (read x) y))(List "en1" "pt1" "p1" "p2")lst1)
(mapcar '(lambda(x y)(set (read x) y))(List "en2" "pt2" "p3" "p4")lst2)
(if(and pt1 pt2 p1 p2 p3 p4 (setq ipt(inters p1 p2 p3 p4 nil)))
(progn
(setq ang1(angle ipt pt1)
px1(polar ipt ang1 1)
ang2(angle ipt pt2)
px2(polar ipt ang2 1)
ang3(q:geo:2line:ang2 ipt px1 ipt px2)
obj2(vlax-ename->vla-object en2)
)
(if (setq ang4(getangle (strcat "\n输入新的角度<当前:"(angtos ang3 0 4)">:" )))
(vla-Rotate obj2 (vlax-3d-point ipt) (- ang4 ang3))
)
(vlax-release-object obj2)
)
(prompt "\n确认两条线是否有交点.")
)
)
)
(and ent1(redraw (car ent1) 4))
(and ent2(redraw (car ent2) 4))
(princ)
)

;;取组码值 
(defun sk_dxf(ent code)(cdr(assoc code(entget ent)))) 
;;选择函数 
(defun sk_sel01(str filter / ent loop) 
  (setq loop t 
        str (if (= (type str) 'STR) str "") 
        filter(if (= (type filter) 'LIST) (mapcar 'strcase filter)  nil) 
        )        
  (while loop 
    (if(setq ent(entsel str)) 
      (if (member (strcase (sk_dxf (car ent) 0)) filter) 
      (setq loop nil) 
      ) 
      (setq loop nil) 
    ) 
    ) 
  (if ent ent) 
  ) 
;;取拾取点附近直线或轻多段线两端点 
(defun sk_nearest(ent / en end_pt index index+ lst obj p0 p1 p3 p4) 
  (setq en(car ent) 
        p0(cadr ent) 
        ) 
  (cond 
    ((= (sk_dxf en 0) "LINE") 
     (setq p1(vlax-curve-getClosestPointTo en p0)) 
     (setq lst(list en p1 (sk_dxf en 10)(sk_dxf en 11))) 
     ) 
    ((= (sk_dxf en 0) "LWPOLYLINE") 
     (setq p1(vlax-curve-getClosestPointTo en p0) 
           obj(vlax-ename->vla-object en) 
           end_pt(sk_dxf en 90) 
           index(fix(vlax-curve-getParamAtPoint obj p1)) 
           p3(vlax-curve-getPointAtParam obj index) 
           index+(1+ index) 
           ) 
     (if (and (=(sk_dxf en 70) 1)(> index+ end_pt)) 
       (setq p4 (vlax-curve-getPointAtParam obj 0)) 
       (setq p4 (vlax-curve-getPointAtParam obj index+))               
       ) 
     (vlax-release-object obj) 
     (setq lst(list en p1 p3 p4))      
     ) 
    ) 
  ) 
;;;两线角度函数 
;;;Two line angle 
;;<a href="http://bbs.mjtd.com/forum.php?mod=viewthread&tid=16602&page=1&authorid=250774" target="_blank">http://bbs.mjtd.com/forum.php?mo ... amp;authorid=250774</a> 
;;code by qjchen 
(defun q:geo:2line:ang2(p1 p2 p3 p4) 
  ((lambda(x) (atan (sqrt (abs (- 1.0 (* x x)))) x)) 
     (/ (apply '+ (mapcar '* (mapcar '- p2 p1) (mapcar '- p4 p3))) (distance p1 p2) (distance p3 p4)) 
  ) 
) 
;;主程序 
(defun c:tt(/ ang1 ang2 ang3 ang4 en2 ent1 ent2 ipt lst1 lst2 obj2 p1 p2 p3 p4 pt1 pt2 px1 px2 x y) 
  (if(and (setq ent1(sk_sel01 "\n选择第一条线" '("line" "lwpolyline"))) 
          (list (redraw (car ent1) 3)) 
          (setq ent2(sk_sel01 "\n选择第二条线" '("line" "lwpolyline"))) 
          (list (redraw (car ent2) 3)) 
          ) 
    (progn 
      (setq lst1(sk_nearest ent1) 
            lst2(sk_nearest ent2) 
            ) 
      (mapcar '(lambda(x y)(set (read x) y))(List "en1" "pt1" "p1" "p2")lst1) 
      (mapcar '(lambda(x y)(set (read x) y))(List "en2" "pt2" "p3" "p4")lst2) 
      (if(and pt1 pt2 p1 p2 p3 p4 (setq ipt(inters p1 p2 p3 p4 nil))) 
        (progn 
          (setq ang1(angle ipt pt1) 
                px1(polar ipt ang1 1) 
                ang2(angle ipt pt2) 
                px2(polar ipt ang2 1)        
                ang3(q:geo:2line:ang2 ipt px1 ipt px2) 
                obj2(vlax-ename->vla-object en2) 
                ) 
          (if (setq ang4(getangle (strcat "\n输入新的角度<当前:"(angtos ang3 0 4)">:" ))) 
            (vla-Rotate obj2 (vlax-3d-point ipt) (- ang4 ang3)) 
            ) 
          (vlax-release-object obj2) 
          ) 
        (prompt "\n确认两条线是否有交点.") 
        )       
      )    
    ) 
  (and ent1(redraw (car ent1) 4)) 
  (and ent2(redraw (car ent2) 4)) 
  (princ) 
  )

lucas_3333 · 发表于 2014-6-21 10:03:05

edata 发表于 2014-6-20 23:18
----------------

谢谢e大，

下图中，如果选择左边的线为第一条线，右边的为第二条线，就可以正确更改
如果选择右边的线为第一条线，左边的为第二条线，这样改角度就总是不对了

lucas_3333 · 发表于 2014-6-21 11:35:28

edata 发表于 2014-6-21 11:32

谢谢e大，这会儿要出去，晚些再测试，谢谢

107627ZJ · 发表于 2015-11-16 18:30:40

CAD2007 怎么用啊？命令TT
只显示第一条线，，选择第二条线，，，，命令结束了麻烦给我一个QQ252113063

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

快速改变夹角

最佳答案

点评

评分

本帖子中包含更多资源