明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 413|回复: 1

[讨论] 请大师帮忙优化一下代码,支持弧线。

[复制链接]
发表于 2018-9-1 13:01 | 显示全部楼层 |阅读模式
;;;*********************动态倒角,By 且听风吟09,2160616************************
;;;*****************************************************************************
(defun c:fdd (/ line1 line2 temp        enarc k        dis newr  *error* fun1 fun2 getVertex getVerticalPoint getMidPoint getR getLineAngleByPoint isPointOnLine
                                                                 distanceIn2Line judge2LinePosition getMyCloseNumber getLinelst HH:PickSegEndPt HH:PickArc)
        ;;;***************************************************************************
        ;;;****************************以下是函数*************************************
        ;;;***************************************************************************
        ;;;错误处理函数
  (defun *error*(msg)
    (setvar "cmdecho" echo)
    (entdel enarc)
    (princ msg)
        )
        ;;;更新曲线函数
  (defun fun1 (k line1 line2 enarc dis / lst arcdata oldpt oldr        oldbegin oldend        newpt tempang1 tempang2
                                                                tempang newbegin        newend)
    (if        (null (or (isPointOnLine (cadr k) line1)
                                                                (isPointOnLine (cadr k) line2)
                                                        )
              )
      (progn
                                (setq lst (getR (cadr k) line1 line2 dis))
                                (if lst
                                        (progn
                                                (setq arcdata (entget enarc))
                                                (setq oldpt           (assoc 10 arcdata)
                                                        oldr           (assoc 40 arcdata)
                                                        oldbegin (assoc 50 arcdata)
                                                        oldend   (assoc 51 arcdata)
                                                )
                                                (setq newpt        (cons 10 (car lst))
                                                        newr        (cons 40 (cadr lst))
                                                )
                                                (setq tempang1 (angle (cdr newpt) (caddr lst))
                                                        tempang2 (angle (cdr newpt) (cadddr lst))
                                                )
                                                (if        (or (> (- tempang2 tempang1) pi)
                                                                        (and (< (- tempang2 tempang1) 0)
                                                                                (> (- tempang2 tempang1) (- pi))
                                                                        )
                                                                )
                                                        (progn
                                                                (setq tempang tempang2)
                                                                (setq tempang2 tempang1)
                                                                (setq tempang1 tempang)
                                                        )
                                                )
                                                (setq newbegin (cons 50 tempang1)
                                                        newend   (cons 51 tempang2)
                                                )
                                                (entmod
                                                        (subst newend
                                                                oldend
                                                                (subst newbegin
                                                                        oldbegin
                                                                        (subst newr oldr (subst newpt oldpt arcdata))
                                                                )
                                                        )
                                                )
                                                (grtext -1 (strcat "当前倒角半径:" (rtos (cdr newr))))
                                        )
                                )
                        )
                )
        )
        ;;;获取用户输入函数
  (defun fun2 (k dis)
    (if        (= 114 (cadr k))
      (progn
                                (setq temp (getdist "\n输入最小间隔:"))
                                (princ "\n或输入最小倒角间隔[R]:")
                                temp
                        )
      (setq temp dis)
                )
        )
        ;;;获取两直线交点
        ;;;直线由两个点对列表构成,分别为起点和终点
  (defun getVertex (line1 line2)
    (inters (car line1)
            (cadr line1)
            (car line2)
            (cadr line2)
            nil
                )
        )
        ;;;获取点到直线的垂点
        ;;;直线由两个点对列表构成,分别为起点和终点
  (defun getVerticalPoint (pt line / ang)
    (setq ang (angle (car line) (cadr line)))
    (inters (car line)
            (cadr line)
            pt
            (polar pt (+ ang (/ pi 2)) 1)
            nil
                )
        )
        ;;;获取两个三维点的中点
  (defun getMidPoint (pt1 pt2)
    (list (/ (+ (car pt1) (car pt2)) 2)
                        (/ (+ (cadr pt1) (cadr pt2)) 2)
                        (/ (+ (caddr pt1) (caddr pt2)) 2)
          )
        )
        ;;;返回(圆心 半径 切点1 切点2)
  (defun getR (pt line1        line2 dis / dis1 dis2 center anglst vertexpt ang A m n b c r temppt1 temppt2 temppt3
                                                                angmid)
    (setq anglst (getLineAngleByPoint pt line1 line2))
    (if        (null anglst)
      nil
      (if (equal (car anglst) (cadr anglst))
                                (progn
                                        (setq r (/ (distanceIn2Line line1 line2) 2))
                                        (setq dis1 (- (distance pt (getVerticalPoint pt line1)) r))
                                        (setq dis2 (sqrt (- (* r r) (* dis1 dis1))))
                                        (setq        center (polar (polar pt (car anglst) dis2)
                                                                                                 (angle pt (getVerticalPoint pt line1))
                                                                                                 dis1
                                                                                         )
                                        )
                                        (list        center
                                                r
                                                (getVerticalPoint center line1)
                                                (getVerticalPoint center line2)
                                        )
                                )
                                (progn
                                        (setq vertexpt (getVertex line1 line2))
                                        (setq ang (abs (- (car anglst) (cadr anglst))))
                                        (if (> ang pi)
                                                (setq ang (- (* 2 pi) ang))
                                        )
                                        (setq ang (/ ang 2))
                                        (if (/= (cos ang) 0)
                                                (setq A (/ (sin ang) (cos ang)))
                                                (setq A 0)
                                        )
                                        (setq m (distance pt (getVerticalPoint pt line1)))
                                        (setq        n (sqrt        (- (* (distance pt vertexpt)
                                                                                                                 (distance pt vertexpt)
                                                                                                         )
                                                                                                        (* m m)
                                                                                                )
                                                                        )
                                        )
                                        (setq b (- (+ (* 2 A n) (* 2 A A m))))
                                        (setq c (+ (* A A m m) (* A A n n)))
                                        (setq        r (/ (+        (- b)
                                                                                         (sqrt (- (* b b) (* 4 c)))
                                                                                 )
                                                                                2
                                                                        )
                                        )
                                        (setq r (getMyCloseNumber r dis))
                                        (if (/= (cos ang) 0)
                                                (setq dis (setq dis (/ r (/ (sin ang) (cos ang)))))
                                                (setq dis 0)
                                        )
                                        (setq        temppt1        (polar vertexpt (car anglst) 10)
                                                temppt2        (polar vertexpt (cadr anglst) 10)
                                                temppt3        (getMidPoint temppt1 temppt2)
                                                angmid        (angle vertexpt temppt3)
                                        )
                                        (list        (polar vertexpt
                                                                        angmid
                                                                        (/ r (sin ang))
                                                                )
                                                r
                                                (polar vertexpt (car anglst) dis)
                                                (polar vertexpt (cadr anglst) dis)
                                        )
                                )
                        )
                )
        )
        ;;;根据已知点获取两直线在该点方向的两边方向
        ;;;line1和line2都是两点组成的列表
        ;;;返回列表(ang1 ang2)
        ;;;如果两直线平行,点在直线之间时,返回两个line1的角度,否则返回nil
        ;;;如果点在直线上,返回nil
  (defun getLineAngleByPoint (pt line1 line2 / vertexpoint temppt p1 p2 pt1 pt2)
    (setq vertexpoint (inters (car line1)
                                                                                                (cadr line1)
                                                                                                (car line2)
                                                                                                (cadr line2)
                                                                                                nil
                                                                                        )
          )
    (if        (or (isPointOnLine pt line1)
                                        (isPointOnLine pt line2)
                                )
      nil
      (if vertexpoint
                                (progn
                                        (setq        p1 (polar pt (angle (car line1) (cadr line1)) 10)
                                                p2 (polar pt (angle (car line2) (cadr line2)) 10)
                                        )
                                        (setq        pt1 (inters p1 pt (car line2) (cadr line2) nil)
                                                pt2 (inters p2 pt (car line1) (cadr line1) nil)
                                        )
                                        (list (angle vertexpoint pt1) (angle vertexpoint pt2))
                                )
                                (progn
                                        (setq temppt (inters (car line1) pt (car line2) (cadr line2) nil))
                                        (if (< (max (distance pt temppt) (distance (car line1) pt))
                                                                (distance (car line1) temppt)
                                                        )
                                                (list (angle (car line1) (cadr line1))
                                                        (angle (car line1) (cadr line1))
                                                )
                                                nil
                                        )
                                )
                        )
                )
        )
        ;;;判断点是否在直线上
        ;;;直线是两点列表
  (defun isPointOnLine (pt line / p1 temppt)
    (setq p1 (polar pt (+ (/ pi 2) (angle (car line) (cadr line))) 10))
    (setq temppt (inters p1 pt (car line) (cadr line) nil))
    (if        (equal pt temppt)
      T
      nil
                )
        )
        ;;;获取两平行直线之间的距离
        ;;;直线是两点列表
  (defun distanceIn2Line (line1 line2 / temppt pt)
    (if        (= (judge2LinePosition line1 line2) 0)
      (progn
                                (setq temppt (polar (car line1)
                                                                                         (+ (/ pi 2) (angle (car line1) (cadr line1)))
                                                                                         10
                                                                                 )
              )
                                (setq pt (inters (car line1) temppt (car line2) (cadr line2) nil))
                                (distance pt (car line1))
                        )
      nil
                )
        )
        ;;;判断两直线位置关系
        ;;;直线是两点列表
        ;;;返回0表示平行但不重合,返回1表示垂直,返回2表示重合,返回3表示相交
  (defun judge2LinePosition (line1 line2 / ang1 ang2 ang)
    (setq ang1 (angle (car line1) (cadr line1))
                        ang2 (angle (car line2) (cadr line2))
                        ang3 (angle (car line1) (car line2))
                        ang4 (angle (car line1) (cadr line2))
          )
    (setq ang (abs (- ang1 ang2)))
    (if        (= ang3 ang4)
      2
      (cond ((= ang 0) 0)
                                ((= ang pi) 0)
                                ((= ang (* pi 0.5)) 1)
                                ((= ang (* pi 1.5)) 1)
                                (T 3)
            )
                )
        )
        ;;;获取最接近数a的数,该数是数b的整数倍
  (defun getMyCloseNumber (a b)
    (if        (/= b 0)
      (* (read (rtos (/ a b) 2 0)) b)
      a
                )
        )
        ;;;将点选的直线/多段线转化为两点列表
        ;;;en表示(entsel)获取的对象和点
        ;;;返回两点列表
  (defun getLinelst (en)
    (setq endata (entget (car en)))
    (if        (equal "LINE" (cdr (assoc 0 endata)))
      (list (cdr (assoc 10 endata)) (cdr (assoc 11 endata)))
      (if (or (equal "LWPOLYLINE" (cdr (assoc 0 endata)))
                                                (equal "OLYLINE" (cdr (assoc 0 endata)))
                                        )
                                (progn
                                        (setq obj (vlax-ename->vla-object (car en)))
                                        (if (HH:PickArc obj (cadr en))
                                                (HH:PickSegEndPt obj (cadr en))
                                                nil
                                        )
                                )
                                nil
                        )
                )
        )
        ;;;************以下函数引用自“明经CAD社区”,By 自贡黄明儒,在此表示感谢,向其致敬***************
        ;;;************网址http://bbs.mjtd.com/thread-108149-1-1.html*************************************
  ;;164.18 [功能] 多段线所点击子段的两端点列表
  ;;示例(HH:PickSegEndPt (car(setq en(entsel))) (cadr en))
  (defun HH:PickSegEndPt (obj p / pp n)
    (setq pp (vlax-curve-getclosestpointto obj (trans p 1 0))
                        n  (fix (vlax-curve-getparamatpoint obj pp))
          )
    (list (vlax-curve-getPointAtParam obj n)
                        (vlax-curve-getPointAtParam obj (1+ n))
          )
        )
  ;;164.24 [功能] 多段线所击子段是否是直线(返回nil是弧) By 自贡黄明儒
  ;;示例(HH:PickArc (car(setq en(entsel))) (cadr en))
  (defun HH:PickArc (curve p / PP)
    (setq pp (vlax-curve-getclosestpointto curve (trans p 1 0)))
    (setq pp (vlax-curve-getSecondDeriv
                                                         curve
                                                         (fix (vlax-curve-getparamatpoint curve pp))
                                                 )
          )
    (equal pp '(0.0 0.0 0.0))
        )
        ;;;*******************************************************************************
        ;;;*****************************以下是代码入口************************************
        ;;;*******************************************************************************
  (vl-load-com)
  (setq echo (getvar "cmdecho"))
  (setvar "cmdecho" 0)
        (setq l1  (entsel "\n选取第一个对象:"))
  (setq l2  (entsel "\n选取第二个对象:"))

        (setq line1 (getLinelst l1))
  (setq line2 (getLinelst l2))
  (if (and line1 line2)
  (progn
  ;(setq line1 (getLinelst (entsel "\n选取第一个对象:")))
  ;(setq line2 (getLinelst (entsel "\n选取第二个对象:")))
  (if (or (= 0 (judge2LinePosition line1 line2))
                                (= 2 (judge2LinePosition line1 line2))
                        )
    (progn
      (princ "\n两直线平行!暂不支持!")
      (exit)
                )
    (progn
      (entmake
                                '((0 . "ARC") (10 0 0 0) (40 . 1) (50 . 0) (51 . 0))
                        )
      (setq enarc (entlast))
      (setq dis 0)
                        ;;;左键退出循环
      (princ "\n或设置最小倒角间隔[R]:")
      (while (null (member (car (setq k (grread T))) '(3 25)))
                                (cond ((= 5 (car k)) (fun1 k line1 line2 enarc dis))
                                        ((= 2 (car k))
                                                (if (null (numberp (setq dis (fun2 k dis))))
                                                        (progn
                                                                (princ "\n最小间隔距离设置失败,已重置为0")
                                                                (setq dis 0)
                                                        )
                                                )
                                        )
              )
                        )
      (grtext -1 "")
                )
        )
        (setvar "FILLETRAD" (cdr newr))
        (vl-cmdf "fillet" "T" "T" l1 l2)
        (entdel enarc)

  )

  )

  (setvar "cmdecho" echo)
  (princ)
)
   这个是网上找的,现在只支持直线,请大师帮忙优化一下代码,支持弧线。万分感谢。平行线能支持最好了。


您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-4-25 06:20 , Processed in 0.347386 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表