[求助]：帮忙编写一个画折断线的lisp

guanhuaming

帮忙编写一个画折断线的代码，折断线如下图所示：

guanhuaming

已有如下代码，可在cad 2004中画了后会出现一些问题：

在cad 2004中画了折断线后出现的问题如下：
   1. 画好的折断线没法改变图层、颜色等。
   2. 画好的折断线没法炸开、拉缩等。
哪位好心人帮忙改进一下或重写一个?谢谢!

;;; *-------------------------------------------------------
;;; * block  块头: name--块名,第一字符为"*"时,此块为无名块,
;;; *                         "*"后的字符被忽去
;;; *                   ins_x,ins_y,ins_z--插人点座标
;;; *-------------------------------------------------------

(defun block(name ins_x ins_y ins_z / attr1 na att ins tab)

  (setq attr1 64)
  (if (= (substr name 1 1) "*")  ; 无名块处理
      (progn
        (setq attr1 (1+ attr1))
      )
  )

  (setq na  (cons 2 name) )
  (setq att (cons 70 attr1) )
  (setq ins (list 10 ins_x ins_y ins_z) )
  (setq tab (list '(0 . "block") na att ins) )
  (entmake tab )
) ; end of block


;;; *------------------------------------
;;; *  endblk 块尾
;;; *  此函数返回所生成的块名
;;; *------------------------------------
(defun endblk()
  (entmake  '( (0 . "endblk")
             )
  )
) ; end of endblk

;;; *-------------------------------------------
;;; * insert(name x y z sx sy sz rot r c rd cd)
;;; * 块插人
;;; *------------------------------------------

(defun insert(name                   ; 块名
              ins_x ins_y ins_z    ; 插人点 (x,y,z)
              sca_x sca_y sca_z    ; X,Y,Z 比例
              rot                   ; 旋转角
              row  col                   ; 行数 , 列数
              row_dist col_dist    ; 行间距 , 列间距
            / na ins scax scay scaz
              row1 col1 row_d col_d
              tab
              )
   (setq na    (cons 2 name))                     ; 块名
   (setq ins   (list 10 ins_x ins_y ins_z))  ; 插人点
   (setq scax  (cons 41 sca_x))              ; X 比例
   (setq scay  (cons 42 sca_y))              ; Y 比例
   (setq scaz  (cons 43 sca_z))              ; Z 比例
   (setq ro    (cons 50 rot))                     ; 旋转角
   (setq row1  (cons 71 row))                     ; 行数
   (setq col1  (cons 70 col))                     ; 列数
   (setq row_d (cons 45 row_dist))             ; 行间距
   (setq col_d (cons 44 col_dist))             ; 列间距
   (setq tab   (list '(0 . "insert") na ins scax scay scaz ro
                 row1 col1 row_d col_d
               )
   )
   (entmake tab)

) ; end of insert

;;; *---------------------------------------------
;;; * pline(flag sw ew)  复线头
;;; * vertex(x y z sw ew td ddflag) 复线顶点
;;; * seqend 复线尾
;;; * 各变量取值参见DXF组码
;;; *---------------------------------------------

(defun pline(flag sw ew  ; 多义线标置, 起始宽, 终止宽
             / ddbs heigh flag sw ew tab)
   (setq pl    (cons 0 "POLYLINE"))
   (setq ddbs  (cons 66 1))
   (setq heigh (list 10 0 0 0))
   (setq flag  (cons 70 flag))
   (setq sw    (cons 40 sw))
   (setq ew    (cons 41 ew))
   (setq tab   (list pl ddbs heigh flag sw ew))
   (entmake tab)
)

(defun        vertex(x y z sw ew td ddflag ; 复线顶点
               ; x,y,z--复线顶点
               ; sw,ew--起始宽, 终止宽
               ; td ----凸度
               ; ddflag--顶点标置
               / vert pt tab)
     (setq vert  (cons 0 "VERTEX"))
     (setq sw         (cons 40 sw))
     (setq ew         (cons 41 ew))
     (setq td         (cons 42 td))
     (setq ddflag (cons 70 ddflag))
     (setq pt (list 10 x y z))
     (setq tab (list vert pt sw ew td ddflag))
     (entmake tab)
)

(defun seqend()    ; 复线尾
     (entmake '((0 . "seqend")))
)

;;; *-----------------------------------------------
;;; * zdx 折断线
;;; *-----------------------------------------------

(defun c:zdx( / d _d d3 dist l pt1 pt2        ang nam name
                pt1_x pt1_y pt1_z ss)
   (setq pt1 (getpoint        "指定第一点:"))
   (setq pt2 (getpoint        pt1 "指定第二点:"))

   ; 求转角
   (setq ang (angle pt1 pt2))

   ; 两点间距 dist
   (setq dist (distance pt1 pt2))

   ; 插入点
   (setq pt1_x (car pt1) pt1_y (cadr pt1) pt1_z (caddr pt1))

   ; 折断间距
   (if (> dist        200.0)
       (setq d (/ dist 50.0)) (setq d (/ dist 40.0))   )
   (if (< dist 100.00) (setq d (/ dist 30.0)) )
   (if (< dist 50.00) (setq d (/ dist 20.0)) )
   (if (< dist 20.00) (setq d (/ dist 12.0)) )
   (setq l (/ (- dist d) 2.0)) ; l=dist/2-d

   ; 画折线
   (setq d1 (/ d 1.0)
         d2 (* d1 -1.0)
         l1 (/ dist 2.0)
         l2 (+ l d)
   )
   (block "*zdx" 0 0 0)
   (pline 0 0 0)
   (vertex 0         0   0 0 0 0 0)
   (vertex l         0   0 0 0 0 0)
   (vertex l1         d1  0 0 0 0 0)
   (vertex l1         d2  0 0 0 0 0)
   (vertex l2         0   0 0 0 0 0)
   (vertex dist  0   0 0 0 0 0)
   (seqend)
   (setq name (endblk))

   ; 插入
   (insert name pt1_x pt1_y pt1_z  1 1 1 ang 1 1 0 0)
   (princ)
)

lsjjm

最初由 guanhuaming 发布
[B]帮忙编写一个画折断线的代码...[/B]

1. 利用ET工具
Express-Draw-Breakline Symbol.
2. 参考这个:
(defun c:test ()
  (setq p0 (getpoint "\nInput point"))
  (setq pe (getpoint p0 "\nInput Second Point:"))
  (setq         a (angle p0 pe)
         h (* (getvar "dimscale") 0.18)
        p1 (polar p0 a (- (/ (distance p0 pe) 2) h))
        p2 (polar p1 (+ a (/ pi 2)) h)
        p4 (polar p1 a (+ h h))
        p3 (polar p4 (- a (/ pi 2)) h))
  (vl-cmdf "pline" p0 p1 p2 p3 p4 pe "")
)