全部币求助：中心线按不同梁宽改为不同颜色，同一梁宽颜色相同。

x_s_s_1 · 发表于 2012-12-11 17:12:53

这个看合适不

(defun x_ssn (ss / n lst)
(repeat (setq N (sslength ss))
(setq LST (cons (ssname SS (setq N (1- N))) LST))
)
)
(defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)
(entmake (list '(0 . "text")
'(100 . "AcDbEntity")
(cons 8 l_n)
'(100 . "AcDbText")
(cons 10 t_10)
(cons 1 t_t)
(cons 40 t_h)
(cons 41 t_w)
(cons 7 t_st)
(cons 72 t_72)
(cons 11 t_11)
(cons 50 t_50)
(cons 73 t_73)
) ;_ 结束list
) ;_ 结束entmake
) ;_ 结束defun
(defun ch_dxf (en num ch / old_num new_num ent)
(if (setq ent (entget en)
new_num (cons num ch)
old_num (assoc num ent)
)
(entmod (subst new_num old_num ent))
(entmod (reverse (cons new_num (reverse ent))))
)
)
(defun beam_w (en lay / ent pt1 pt2 mid_pt ang n ss dist)
;;; (setq en (car(entsel)) lay "11-Y")
(setq ent (entget en))
(setq pt1 (cdr (assoc 10 ent))
pt2 (cdr (assoc 11 ent))
)
(setq mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2))
(setq ang (angle pt1 pt2))
(setq n 0)
(while
(= nil
(setq ss
(ssget "f"
(list (polar mid_pt (+ ang (/ pi 2)) (+ 76 (* n 25)))
(polar mid_pt (+ ang (/ pi -2)) (+ 76 (* n 25)))
)
(list '(0 . "line") (cons 8 lay))
)
)
)
(setq n (1+ n))
)
(setq dist (* 2
(distance mid_pt
(vlax-curve-getClosestPointTo
(vlax-ename->vla-object (ssname ss 0))
mid_pt
)
)
)
)
(t_mak "0"
'(0 0 0)
mid_pt
(strcat "梁宽" (rtos dist))
ang
1
0
250
0.75
"standard"
)
dist
)
(defun m_dela (m_list / x m_list1)
(setq m_list1 nil)
(mapcar '(lambda (x)
(if (not (member x m_list1))
(setq m_list1 (cons x m_list1))
)
)
m_list
)
(setq m_list (reverse m_list1))
)
(defun c:test1 (/ ss1 ss2 lst1 lst2 n)
(setq ss1 (ssget '((0 . "line") (8 . "5"))))
(setq ss2 (ssget "X" '((0 . "line") (8 . "11-Y"))))
(mapcar '(lambda (x) (ch_dxf x 6 "continuous")) (x_ssn ss2))
(setq lst1 (mapcar '(lambda (x) (list (rtos (beam_w x "11-Y")) x))
(x_ssn ss1)
)
)
(setq
lst2 (m_dela
(mapcar '(lambda (x) (rtos (beam_w x "11-Y"))) (x_ssn ss1))
)
)
(setq n 0)
(while (< n (length lst2))
(mapcar '(lambda (x)
(if (member (nth n lst2) x)
(vla-put-color (vlax-ename->vla-object (cadr x)) (1+ n))
t
)
)
lst1
)
(setq n (1+ n))
)
(mapcar '(lambda (x) (ch_dxf x 6 "DASH")) (x_ssn ss2))
(princ)
)

(defun x_ssn (ss / n lst) 
  (repeat (setq N (sslength ss)) 
    (setq LST (cons (ssname SS (setq N (1- N))) LST)) 
  ) 
) 
(defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /) 
  (entmake (list '(0 . "text") 
     '(100 . "AcDbEntity") 
     (cons 8 l_n) 
     '(100 . "AcDbText") 
     (cons 10 t_10) 
     (cons 1 t_t) 
     (cons 40 t_h) 
     (cons 41 t_w) 
     (cons 7 t_st) 
     (cons 72 t_72) 
     (cons 11 t_11) 
     (cons 50 t_50) 
     (cons 73 t_73) 
     ) ;_ 结束list 
  ) ;_ 结束entmake 
) ;_ 结束defun 
(defun ch_dxf (en num ch / old_num new_num ent) 
  (if (setq ent      (entget en) 
      new_num (cons num ch) 
      old_num (assoc num ent) 
      ) 
    (entmod (subst new_num old_num ent)) 
    (entmod (reverse (cons new_num (reverse ent)))) 
  ) 
) 
(defun beam_w (en lay / ent pt1 pt2 mid_pt ang n ss dist) 
;;;  (setq en (car(entsel)) lay "11-Y") 
  (setq ent (entget en)) 
  (setq  pt1 (cdr (assoc 10 ent)) 
  pt2 (cdr (assoc 11 ent)) 
  ) 
  (setq mid_pt (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2)) 
  (setq ang (angle pt1 pt2)) 
  (setq n 0) 
  (while 
    (= nil 
       (setq ss 
        (ssget "f" 
         (list (polar mid_pt (+ ang (/ pi 2)) (+ 76 (* n 25))) 
         (polar mid_pt (+ ang (/ pi -2)) (+ 76 (* n 25))) 
         ) 
         (list '(0 . "line") (cons 8 lay)) 
        ) 
       ) 
    ) 
     (setq n (1+ n)) 
  ) 
  (setq  dist (*  2 
    (distance mid_pt 
        (vlax-curve-getClosestPointTo 
          (vlax-ename->vla-object (ssname ss 0)) 
          mid_pt 
        ) 
    ) 
       ) 
  ) 
  (t_mak "0" 
   '(0 0 0) 
   mid_pt 
   (strcat "梁宽" (rtos dist)) 
   ang 
   1 
   0 
   250 
   0.75 
   "standard" 
  ) 
  dist 
) 
(defun m_dela (m_list / x m_list1) 
  (setq m_list1 nil) 
  (mapcar '(lambda (x) 
       (if (not (member x m_list1)) 
         (setq m_list1 (cons x m_list1)) 
       ) 
     ) 
    m_list 
  ) 
  (setq m_list (reverse m_list1)) 
) 
(defun c:test1 (/ ss1 ss2 lst1 lst2 n) 
  (setq ss1 (ssget '((0 . "line") (8 . "5")))) 
  (setq ss2 (ssget "X" '((0 . "line") (8 . "11-Y")))) 
  (mapcar '(lambda (x) (ch_dxf x 6 "continuous")) (x_ssn ss2)) 
  (setq  lst1 (mapcar '(lambda (x) (list (rtos (beam_w x "11-Y")) x)) 
         (x_ssn ss1) 
       ) 
  ) 
  (setq 
    lst2 (m_dela 
     (mapcar '(lambda (x) (rtos (beam_w x "11-Y"))) (x_ssn ss1)) 
   ) 
  ) 
  (setq n 0) 
  (while (< n (length lst2)) 
    (mapcar '(lambda (x) 
         (if (member (nth n lst2) x) 
     (vla-put-color (vlax-ename->vla-object (cadr x)) (1+ n)) 
     t 
         ) 
       ) 
      lst1 
    ) 
    (setq n (1+ n)) 
  ) 
  (mapcar '(lambda (x) (ch_dxf x 6 "DASH")) (x_ssn ss2)) 
  (princ) 
)

x_s_s_1 · 发表于 2012-12-11 17:15:00

本帖最后由 x_s_s_1 于 2012-12-11 17:17 编辑

zzc83 发表于 2012-12-11 16:43
谢谢叮咚，经测试，基本满足要求，能不能增加容差处理，比如设置容差5, 200梁和195 205的梁都是一个颜色 ...

没有梁宽限制，实测多少就是多少，但是要中心线，给了源码，如不是中心线的可根据自己需要改改。

zzc83 · 发表于 2012-12-11 17:41:10

本帖最后由 zzc83 于 2012-12-11 17:43 编辑

叮咚发表于 2012-12-11 16:59
你们做的什么东西，梁宽，还有195 205 这种？
最好有个梁宽的规格 240 200 300 ……

有人画图极度不标准，才有会这样的情况，而且画斜梁也容易出现这样的情况
请帮忙加一下，谢谢

zzc83 · 发表于 2012-12-11 17:46:10

本帖最后由 zzc83 于 2012-12-11 17:47 编辑

x_s_s_1 发表于 2012-12-11 17:12
这个看合适不

谢谢帮忙
选择对象: 参数类型错误: lselsetp nil

zzc83 · 发表于 2012-12-11 18:32:14

本帖最后由 zzc83 于 2012-12-11 18:39 编辑

x_s_s_1 发表于 2012-12-11 17:15
没有梁宽限制，实测多少就是多少，但是要中心线，给了源码，如不是中心线的可根据自己需要改改。

可以用了，谢谢先。还是没有容差处理的功能啊。

叮咚 · 发表于 2012-12-12 08:40:08

x_s_s_1 发表于 2012-12-11 17:12
这个看合适不

没有梁宽限制，如果没有两边的线，怎么办？只有一边有线怎么办？

zzc83 · 发表于 2012-12-12 13:07:01

叮咚发表于 2012-12-12 08:40
没有梁宽限制，如果没有两边的线，怎么办？只有一边有线怎么办？

最好可以标示梁宽0并圈出来

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

全部币求助：中心线按不同梁宽改为不同颜色，同一梁宽颜色相同。

本帖子中包含更多资源

评分

点评

点评