[nm]由直线定义多线样式
本帖最后由 brbright 于 2015-12-8 12:13 编辑一直在用Msteel的截面【参数与绘制】画钢结构构件。Msteel做的已经很好。
然而，我还是想自己尝试一下。
这个LISP可以将获取直线间的间距、线型和颜色，并将之定义一个多线样式。
如果直线不平行，将【取点】对第一条直线作【垂线】，【垂线】与【其他直线】间的交点计算距离（就是作横截面的意思）。
本帖最后由 brbright 于 2015-12-8 12:14 编辑
(vl-load-com)
(defun C:nm (/ tx_en_1
tx_normal_line t_1
t_acad_mlinestyle_list t_acad_mlinestyle_name_list
t_color t_endpoint
t_linetype t_line_offset
t_list_1 t_list_2
t_mline_elements_list t_mline_elements_list_head
t_mline_elements_list_tail
t_mline_style_name t_normal_line_angle_90
t_normal_line_cross_point
t_normal_line_endpoint t_normal_line_startpoint
t_point_base t_point_inters
t_point_ref t_point_top
t_ss t_startpoint
)
;;取得系统样式表
(setq t_acad_mlinestyle_list
(dictsearch (namedobjdict) "ACAD_MLINESTYLE")
)
;;取得系统样式名称列表
(setq t_acad_mlinestyle_name_list
(mapcar 'cdr
(vl-remove-if-not
'(lambda (x) (= (car x) 3))
t_acad_mlinestyle_list
)
)
)
;;请求输入样式名
(setq t_MLINE_STYLE_NAME
(strcase (getstring "新样式名:"))
)
;;判断样式名是否存在，存在则退出
(if (vl-position t_MLINE_STYLE_NAME t_acad_mlinestyle_name_list)
(progn (alert "多线样式已存在，程序退出")
(exit)
)
)
;;取得直线对象选择集
(princ "\n选择直线,第一条直线为正方向:")
(setq t_ss (ssget '((0 . "LINE"))))
;;(setq t_ss (ssget))
(setq t_point_base (getpoint "\n选择轴线和横截面的交点："))
(setq t_point_top (getpoint "\n取点判断多线上方向(Top)："))
;;选取第一条直线作多线方向
(setq tx_normal_line (vlax-ename->vla-object (ssname t_ss 0)))
;;获得直线起点
(setq t_normal_line_StartPoint
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property tx_normal_line 'StartPoint)
)
)
)
;;获得直线终点
(setq t_normal_line_EndPoint
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property tx_normal_line 'EndPoint)
)
)
)
;;直线角度
(setq t_normal_line_angle_90
(+ (angle t_normal_line_StartPoint
t_normal_line_EndPoint
)
(/ pi 2)
)
)
;;获得轴线点到方向直线投影点，用于横截面线
(setq t_normal_line_cross_point
(polar t_point_base
t_normal_line_angle_90
1000.1
)
)
;;创建参考点表、图层、线型表
(setq t_list_1 (list))
(setq t_1 0)
(repeat (sslength t_ss)
;;遍历所有选择集直线对象，转vla-object
(setq tx_en_1 (vlax-ename->vla-object (ssname t_ss t_1)))
;;获得颜色
(setq t_Color (vlax-get-property tx_en_1 'Color))
;;获得线型
(setq t_Linetype (vlax-get-property tx_en_1 'Linetype))
;;获得直线起点
(setq t_StartPoint
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property tx_en_1 'StartPoint)
)
)
)
;;获得直线终点
(setq t_EndPoint
(vlax-safearray->list
(vlax-variant-value
(vlax-get-property tx_en_1 'EndPoint)
)
)
)
;;获得横截线到直线交点
(setq t_point_inters
(inters
t_point_base t_normal_line_cross_point
t_StartPoint t_EndPoint
nil
)
)
;;将轴线点、投影点、颜色、线型数据填到表中
(setq t_list_1
(cons
(list t_point_base t_point_inters t_Color t_Linetype)
t_list_1
)
)
(setq t_1 (1+ t_1))
)
;;表顺序修正
(setq t_list_1 (reverse t_list_1))
;;投影上方向点作为参考方向
(setq t_point_ref
(lm:projectpointtoline
t_point_top
t_point_base
t_normal_line_cross_point
)
)
;;创建偏移距离、图层、线型表
(setq t_list_2 (list))
(foreach t_each t_list_1
;;计算点距作为偏移距离
(setq t_line_offset
(distance (car t_each) (cadr t_each))
)
;;非零则修正方向
(if (= t_line_offset 0)
(princ)
(setq t_line_offset
;;修正方向
(* (br:3_point_cosa
t_point_base
t_point_ref
(cadr t_each)
)
t_line_offset
)
)
)
;;填表
(setq t_list_2 (cons (list
;;偏移距离
t_line_offset
;;颜色
(caddr t_each)
;;线型
(nth 3 t_each)
)
t_list_2
)
)
)
;;多线样式表表尾
(setq t_mline_elements_list_tail (list))
(foreach t_each t_list_2
;;多线样式单元线型
(setq t_mline_elements_list_tail
(cons (cons 6 (caddr t_each)) t_mline_elements_list_tail)
)
;;多线样式单元颜色
(setq t_mline_elements_list_tail
(cons (cons 62 (cadr t_each)) t_mline_elements_list_tail)
)
;;多线样式单元偏移
(setq t_mline_elements_list_tail
(cons (cons 49 (car t_each)) t_mline_elements_list_tail)
)
)
;;多线样式表表头
(setq t_mline_elements_list_head
(list
;;Object name (MLINESTYLE)
(cons 0 "MLINESTYLE")
;;Subclass marker (AcDbMlineStyle)
(cons 100 "AcDbMlineStyle")
;;多线样式名
(cons 2 t_MLINE_STYLE_NAME)
;;多线样式中的单元（直线）数量
(cons 71 (length t_list_2))
)
)
;;多线样式表生成
(setq t_mline_elements_list
(append t_mline_elements_list_head
t_mline_elements_list_tail
)
)
;;将多线样式表增加到CAD字典数据
(if
(not
(dictadd
(cdar (dictsearch (namedobjdict) "ACAD_MLINESTYLE"))
t_MLINE_STYLE_NAME
(entmakex
t_mline_elements_list
)
)
)
;;失败则弹出警告
(alert
"多线样式添加失败\n多线样式可能已存在"
)
)
(princ)
)
;;使用三点计算角度的cos余弦(余弦定理)
(defun br:3_point_cosa (point_a point_b point_c / a b c)
(setq a (distance point_b point_c))
(setq b (distance point_a point_c))
(setq c (distance point_a point_b))
(if (= (* b c) 0)
(print ": <defun br:3_point_cosa> b*c=0")
)
(/ (+ (* b b) (* c c) (* -1 a a))
(* 2 b c)
)
)
;; project point onto line-lee mac
;; projects pt onto the line defined by p1,p2
(defun lm:projectpointtoline (pt p1 p2 / nm)
(setq nm (mapcar '- p2 p1)
p1 (trans p1 0 nm)
pt (trans pt 0 nm)
)
(trans (list (car p1) (cadr p1) (caddr pt)) nm 0)
)
(PRINC)
这个好用啊~
页:
[1]