[nm]由直线定义多线样式

brbright

一直在用Msteel的截面【参数与绘制】画钢结构构件。Msteel做的已经很好。
然而，我还是想自己尝试一下。
这个LISP可以将获取直线间的间距、线型和颜色，并将之定义一个多线样式。
如果直线不平行，将【取点】对第一条直线作【垂线】，【垂线】与【其他直线】间的交点计算距离（就是作横截面的意思）。

brbright

(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 "[error]: <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)

YANGF85

这个好用啊~

Dea25