如何用LSP实线由linea或Pline形成的树状分枝求每一路经径长度!!!????

ZZXXQQ · 发表于 2011-5-15 19:25

用直接标注线长的程序不行吗？这种程序论坛就有。

Gu_xl · 发表于 2011-5-15 22:16

本帖最后由 Gu_xl 于 2011-5-15 22:23 编辑

回复 xxzwtr 的帖子

这段程序或许对你有帮助，功能：根据选取的直线选择与其相连的所有直线

;;;选择集相减
(defun gxl-Sel-SSsub(ss1 ss2 / ss n)
(cond
((and ss1 ss2)
(setq n 0)
(repeat (sslength ss2)
(ssdel (ssname ss2 n) ss1)
(setq n (1+ n))
)
)
((and ss1 (not ss2))
ss1
)
(T
(setq ss1 nil)
)
)
ss1
)
;;;选择集合并
(defun gxl-Sel-SSJoin ( ss1 ss2 / ename ss cnt )
(if ss1
(progn
(if (= (type ss1) 'ENAME)
(progn
(setq
ename ss1
ss1 (ssadd)
)
(ssadd ename ss1)
))
))
(if ss2
(progn
(if (= (type ss2) 'ENAME)
(progn
(setq
ename ss2
ss2 (ssadd)
)
(ssadd ename ss2)
))
))
(setq ss (ssadd))
(if (and ss1 ss2)
(progn
;(setq ss ss2 cnt 0)
(setq cnt 0)
(repeat (sslength ss2)
(ssadd (ssname ss2 cnt) ss)
(setq cnt (1+ cnt))
)
(setq cnt 0)
(repeat (sslength ss1)
(ssadd (ssname ss1 cnt) ss)
(setq cnt (1+ cnt))
)
))
(if (and ss1 (not ss2))
(setq ss ss1))
(if (and ss2 (not ss1))
(setq ss ss2))
(if (> (sslength ss) 0)
;;(eval ss)
ss
nil
)
)
;;;根据坐标选择直线
(defun gxl-sel-SSgetLineatPoint (pt jd / px py px0 px1 py0 py1 ss pz)
(setq px (car pt)
px0 (- px jd)
px1 (+ px jd)
py (cadr pt)
py0 (- py jd)
py1 (+ py jd)
pz (caddr pt)
)
(setq ss
(ssget "x" (list '(0 . "line")
'(-4 . "<or")
'(-4 . "<and")
'(-4 . ">=,>=,=")
(list 10 px0 py0 pz)
'(-4 . "<=,<=,=")
(list 10 px1 py1 pz)
'(-4 . "and>")
'(-4 . "<and")
'(-4 . ">=,>=,=")
(list 11 px0 py0 pz)
'(-4 . "<=,<=,=")
(list 11 px1 py1 pz)
'(-4 . "and>")
'(-4 . "or>")
)
)
)
ss
)
;;;根据直线选相连直线测试
(defun c:ssgetbyline(/ ssrtl jd pt1 pt2 enline getline)
(defun getline (pt jd / s s1 n p1 p2)
(setq s (gxl-sel-SSgetLineatPoint pt jd))
(if s
(progn
(setq s1 (GXL-SEL-SSSUB s ssrtl)
ssrtl (GXL-SEL-SSJOIN ssrtl s1)
)
(if s1
(progn
(setq n 0)
(repeat (sslength s1)
(setq p1 (cdr (assoc 10 (entget (ssname s1 n))))
p2 (cdr (assoc 11 (entget (ssname s1 n))))
)
(getline p2 jd)
(getline p1 jd)
(setq n (1+ n))
)
)
)
)
)
)
;;;程序开始
(princ "\n选择直线：")
(setq enline (car (entsel)))
(setq jd (getreal "输入容差精度：<0.001>"))
(if (null jd)(setq jd 0.001))
(setq pt1 (cdr (assoc 10 (entget enline))))
(setq pt2 (cdr (assoc 11 (entget enline))))
(setq ssrtl (ssadd enline))
(getline pt1 jd)
(getline pt2 jd)
(SSSETFIRST nil ssrtl)
ssrtl
)

;;;选择集相减 
(defun gxl-Sel-SSsub(ss1 ss2 / ss n) 
 
(cond 
        ((and ss1 ss2) 
         (setq n 0) 
         (repeat (sslength ss2) 
           (ssdel (ssname ss2 n) ss1) 
           (setq n (1+ n)) 
           ) 
        ) 
        ((and ss1 (not ss2)) 
                ss1 
        ) 
        (T 
                (setq ss1 nil) 
        ) 
) 
ss1 
) 
;;;选择集合并 
(defun gxl-Sel-SSJoin ( ss1 ss2 / ename ss cnt ) 
 
(if ss1 
(progn 
        (if (= (type ss1) 'ENAME) 
        (progn 
                (setq 
                        ename ss1 
                        ss1   (ssadd) 
                ) 
                (ssadd ename ss1) 
        )) 
)) 
 
(if ss2 
(progn 
        (if (= (type ss2) 'ENAME) 
        (progn 
                (setq 
                        ename ss2 
                        ss2   (ssadd) 
                ) 
                (ssadd ename ss2) 
        )) 
)) 
 
(setq ss (ssadd)) 
 
(if (and ss1 ss2) 
(progn 
        ;(setq ss ss2 cnt 0) 
        (setq  cnt 0) 
        (repeat (sslength ss2) 
                (ssadd (ssname ss2 cnt) ss) 
                (setq cnt (1+ cnt)) 
        ) 
        (setq  cnt 0) 
        (repeat (sslength ss1) 
                (ssadd (ssname ss1 cnt) ss) 
                (setq cnt (1+ cnt)) 
        ) 
)) 
 
(if (and ss1 (not ss2)) 
(setq ss ss1)) 
 
(if (and ss2 (not ss1)) 
(setq ss ss2)) 
 
(if (> (sslength ss) 0) 
  ;;(eval ss) 
        ss 
        nil 
) 
) 
;;;根据坐标选择直线 
(defun gxl-sel-SSgetLineatPoint (pt jd /  px py px0 px1 py0 py1 ss pz) 
(setq px (car pt) 
      px0 (- px jd) 
      px1 (+ px jd) 
      py (cadr pt) 
      py0 (- py jd) 
      py1 (+ py jd) 
      pz (caddr pt) 
      ) 
  (setq ss 
(ssget "x" (list '(0 . "line") 
                 '(-4 . "<or") 
         
                 '(-4 . "<and") 
                 '(-4 . ">=,>=,=") 
                 (list 10 px0 py0 pz) 
                 '(-4 . "<=,<=,=") 
                 (list 10 px1 py1 pz) 
                 '(-4 . "and>") 
                  
                 '(-4 . "<and") 
                 '(-4 . ">=,>=,=") 
                 (list 11 px0 py0 pz) 
                 '(-4 . "<=,<=,=") 
                 (list 11 px1 py1 pz) 
                 '(-4 . "and>") 
                  
                 '(-4 . "or>") 
                 ) 
       ) 
  ) 
  ss 
  ) 
;;;根据直线选相连直线测试 
(defun c:ssgetbyline(/ ssrtl jd pt1 pt2 enline  getline) 
  (defun getline (pt jd / s s1 n p1 p2) 
    
    (setq s (gxl-sel-SSgetLineatPoint pt jd)) 
    (if s 
      (progn 
        (setq s1 (GXL-SEL-SSSUB s ssrtl) 
              ssrtl (GXL-SEL-SSJOIN ssrtl s1) 
              ) 
         
        (if s1 
          (progn 
            (setq n 0) 
            (repeat (sslength s1) 
              (setq p1 (cdr (assoc 10 (entget (ssname s1 n)))) 
                    p2 (cdr (assoc 11 (entget (ssname s1 n)))) 
                    ) 
              (getline p2 jd) 
              (getline p1 jd) 
              (setq n (1+ n)) 
              ) 
            ) 
          ) 
        ) 
      ) 
    
    ) 
  ;;;程序开始 
    (princ "\n选择直线：") 
  (setq enline (car (entsel))) 
  (setq jd (getreal "输入容差精度：<0.001>")) 
  (if (null jd)(setq jd 0.001)) 
  (setq pt1 (cdr (assoc 10 (entget enline)))) 
  (setq pt2 (cdr (assoc 11 (entget enline)))) 
(setq ssrtl (ssadd enline)) 
  (getline pt1 jd) 
  (getline pt2 jd) 
  (SSSETFIRST nil ssrtl) 
  ssrtl 
  )

yoyoho · 发表于 2011-5-16 08:40

感谢Gu_xl版主分享学习了!

cable2004 · 发表于 2012-9-28 15:17

好东西，看不太懂，学习。。。。。。。。。。。。

s678z · 发表于 2013-2-5 07:54

有何用途？

Kall · 发表于 2013-3-6 10:35

Mark 一下，谢谢斑竹

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

[基础] 如何用LSP实线由linea或Pline形成的树状分枝求每一路经径长度!!!????

本帖子中包含更多资源

本帖子中包含更多资源