[编程申请]：圆,弧,椭圆及矩形中心线程序修改申请!

fengjunchina

找到一个可批量画圆,圆弧,椭圆及矩形中心线的程序,感觉写的很简练.自己改了一下,原程序只能将中心线延长2mm,现改成延长10%,但也同时存在一个问题,就是画椭圆中心线和矩形中心线时如果长短轴或长短边比比较大时长中心线太长,能否改成先求出短中心线延伸长度,再将这个长度加上长边及长轴画中心线,这样会更好看些.另外想再加个画两条直线的中心线不知如何加!还请高人指点指点!!!
[PHP]
;; 根据选择对像画中心线
(defun c:rcen()
        (command "_undo" "be")
        (setq sel-set (ssget))
        (setq oldecho (getvar "cmdecho"))
        (setq oldsnap (getvar "osmode"))
        (setq oldlayer (getvar "clayer"))
            (if (= nil (tblsearch"layer" "3"))
                 (command "-layer" "n" "3" "c" "1" "3" "lt" "center2" "3" "")
            )
        (setvar "clayer" "3")
        (setvar "osmode" 0)
        (setq i 0)
        (while (< i (sslength sel-set))
                (setq ent (ssname sel-set i))
                (setq ent-list (entget ent))
                (setq ent-type-str (cdr (assoc 0 ent-list)))
                (if (= ent-type-str "CIRCLE")
                        (progn
                                (setq p-cir-cen (cdr (assoc 10 ent-list)))
                                (setq radius (cdr (assoc 40 ent-list)))
                                (setq p-right-mid (polar p-cir-cen 0 (* radius 1.2)))
                                (setq p-upper (polar p-cir-cen (* 0.5 pi) (* radius 1.2)))
                                (setq p-left-mid (polar p-cir-cen pi (* radius 1.2)))
                                (setq p-down (polar p-cir-cen (* -0.5 pi) (* radius 1.2)))
                                (command "_line" p-left-mid p-right-mid "")
                                (command "_line" p-down p-upper "")
                                )
                        )
                (if (= ent-type-str "ARC")
                        (progn
                                (setq p-arc-cen (cdr (assoc 10 ent-list)))
                                (setq radius (cdr (assoc 40 ent-list)))
                                (setq p-right-mid (polar p-arc-cen 0 (* radius 1.2)))
                                (setq p-upper (polar p-arc-cen (* 0.5 pi) (* radius 1.2)))
                                (setq p-left-mid (polar p-arc-cen pi (* radius 1.2)))
                                (setq p-down (polar p-arc-cen (* -0.5 pi) (* radius 1.2)))
                                (command "_line" p-left-mid p-right-mid "")
                                (command "_line" p-down p-upper "")
                                )
                        )
                (if (= ent-type-str "ELLIPSE")
                        (progn
                                (setq p-el-cen (cdr (assoc 10 ent-list)))
                                (setq half-long-axis-len (distance (list 0 0) (cdr (assoc 11 ent-list))))
                                (setq half-short-axis-len (* (cdr (assoc 40 ent-list)) half-long-axis-len))
                                (setq rot-angle (angle (list 0 0) (cdr (assoc 11 ent-list))))
                                (setq p-right-mid (polar p-el-cen rot-angle (* half-long-axis-len 1.2)))
                                (setq p-upper (polar p-el-cen (+ (* 0.5 pi) rot-angle) (* half-short-axis-len 1.2)))
                                (setq p-left-mid (polar p-el-cen (+ pi rot-angle) (* half-long-axis-len 1.2)))
                                (setq p-down (polar p-el-cen (+ (* 1.5 pi) rot-angle) (* half-short-axis-len 1.2)))
                                (command "_line" p-left-mid p-right-mid "")
                                (command "_line" p-down p-upper "")
                                )
                        )
                (if (and (= ent-type-str "LWPOLYLINE") (= (cdr (assoc 90 ent-list)) 4) (= (cdr (assoc 70 ent-list)) 1))
                        (progn
                                (setq p-down-left (cdr (nth 14 ent-list)))
                                (setq p-down-right (cdr (nth 18 ent-list)))
                                (setq p-upper-right (cdr (nth 22 ent-list)))
                                (setq p-upper-left (cdr (nth 26 ent-list)))
                                (setq rot-ang (angle p-down-left p-down-right))
                                (setq p-mid (polar p-down-left (angle p-down-left p-upper-right) (* 0.5 (distance p-down-left p-upper-right))))
                                (setq p-right-mid (polar p-mid rot-ang (+ (* 0.5 (distance p-down-left p-down-right)) (* 0.1 (distance p-down-left p-down-right)))))
                                (setq p-upper (polar p-mid (+ (* 0.5 pi) rot-ang) (+ (* 0.5 (distance p-down-right p-upper-right)) (* 0.1 (distance p-down-right p-upper-right)))))
                                (setq p-left-mid (polar p-mid (+ pi rot-ang) (+ (* 0.5 (distance p-down-left p-down-right)) (* 0.1 (distance p-down-left p-down-right)))))
                                (setq p-down (polar p-mid (+ (* 1.5 pi) rot-ang) (+ (* 0.5 (distance p-down-right p-upper-right)) (* 0.1 (distance p-down-right p-upper-right)))))
                                (command "_line" p-left-mid p-right-mid "")
                                (command "_line" p-down p-upper "")
                                )
                        )
                (setq i (1+ i))
                )
        (setvar "cmdecho" oldecho)
        (setvar "osmode" oldsnap)
        (setvar "clayer" oldlayer)
        (command "_undo" "e")
        (princ)
        )
[/PHP]

coolzhb

最初由 fengjunchina 发布
[B]找到一个可批量画圆,圆弧,椭圆及矩形中心线的程序,感觉写的很简练.自己改了一下,原程序只能将中心线延长2mm,现改成延长10%,但也同时存在一个问题,就是画椭圆中心线和矩形中心线时如果长短轴或长短边比比较大时长中心... [/B]

[PHP]
    (if (= ent-type-str "ELLIPSE")
      (progn
        (setq p-el-cen (cdr (assoc 10 ent-list)))
        (setq half-long-axis-len (distance (list 0 0) (cdr (assoc 11
                                                                  ent-list
                                                           )
                                                      )
                                 )
        )
        (setq half-short-axis-len (* (cdr (assoc 40 ent-list))
                                     half-long-axis-len
                                  )
        )
        (setq rot-angle (angle (list 0 0) (cdr (assoc 11 ent-list))))
        (setq adddist (* half-short-axis-len 0.2))
        (setq p-right-mid (polar p-el-cen rot-angle (+ half-long-axis-len
                                                       adddist
                                                    )
                          )
        )
        (setq p-upper (polar p-el-cen (+ (* 0.5 pi) rot-angle) (+ half-short-axis-len
                                                                  adddist
                                                               )
                      )
        )
        (setq p-left-mid (polar p-el-cen (+ pi rot-angle) (+ half-long-axis-len
                                                             adddist
                                                          )
                         )
        )
        (setq p-down (polar p-el-cen (+ (* 1.5 pi) rot-angle) (+ half-short-axis-len
                                                                 adddist
                                                              )
                     )
        )
        (command "_line" p-left-mid p-right-mid "")
        (command "_line" p-down p-upper "")
      )
    )
    (if (and
          (= ent-type-str "LWPOLYLINE")
          (= (cdr (assoc 90 ent-list)) 4)
          (= (cdr (assoc 70 ent-list)) 1)
        )
      (progn
        (setq p-down-left (cdr (nth 14 ent-list)))
        (setq p-down-right (cdr (nth 18 ent-list)))
        (setq p-upper-right (cdr (nth 22 ent-list)))
        (setq p-upper-left (cdr (nth 26 ent-list)))
        (setq rot-ang (angle p-down-left p-down-right))
        (setq p-mid (polar p-down-left (angle p-down-left p-upper-right)
                           (* 0.5 (distance p-down-left p-upper-right))
                    )
        )
        (setq adddist (* 0.2 (min
                               (distance p-down-left p-down-right)
                               (distance p-down-left p-upper-left)
                             )
                      )
        )
        (setq p-right-mid (polar p-mid rot-ang (+ (* 0.5 (distance p-down-left p-down-right))
                                                  adddist
                                               )
                          )
        )
        (setq p-upper (polar p-mid (+ (* 0.5 pi) rot-ang) (+ (* 0.5
                                                                (distance p-down-right p-upper-right)
                                                             ) adddist
                                                          )
                      )
        )
        (setq p-left-mid (polar p-mid (+ pi rot-ang) (+ (* 0.5
                                                           (distance p-down-left p-down-right)
                                                        ) adddist
                                                     )
                         )
        )
        (setq p-down (polar p-mid (+ (* 1.5 pi) rot-ang) (+ (* 0.5
                                                               (distance p-down-right p-upper-right)
                                                            ) adddist
                                                         )
                     )
        )
        (command "_line" p-left-mid p-right-mid "")
        (command "_line" p-down p-upper "")
      )[/PHP]

fengjunchina

感谢二楼大大.已经解决中心线一边长一边短的问题.不知大大有时间再搞搞加个绘制两条直线中心线的程序.