669423907 发表于 2012-3-8 14:19:54

h008 发表于 2012-3-8 09:32 static/image/common/back.gif
我试试,我是菜鸟,写的代码不够漂亮!

(defun 2d_mid (pt1 pt2);求两点中点 这就是函数应该是来自是明 ...

有点小问题:

清风明月名字 发表于 2012-3-16 10:12:26

谢谢楼主,下载用了,很好

成仔 发表于 2012-4-27 13:11:43

很好啊 ,支持

sdwy196912 发表于 2012-4-27 13:24:22

这个必须顶

T_T 发表于 2012-4-27 13:34:29

谢谢楼主,好用不错,

梦醒才知原是梦 发表于 2012-4-27 13:54:26

好东西。。。谢谢分享~~~~

xiaoyingzi 发表于 2012-4-27 22:59:54

本帖最后由 xiaoyingzi 于 2012-4-28 13:25 编辑

修改一下,支持框选,支持圆、圆弧、椭圆、矩形,去掉了平行线


;;源码来自明经通道-燃烧
;;支持圆、圆弧、椭圆、矩形框选加中心线
;;xiaoyingzi修改,增加支持框选和椭圆
(defun c:zxx (/ v1 v2 v3ss n in en endata entype cenpt r
                b l dist ptlist p1 p2 p3 p4 pt1 pt2 pt3 pt4 )
;获得点p1和p2两点的中点坐标
(defun MidPof2P (p1 p2)
    (mapcar '(lambda(x y) (/ (+ x y) 2.0) ) p1 p2)
)
(setq v1 (getvar "osmode"))
(setq v2 (getvar "cmdecho"))
(setq v3 (getvar "clayer"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(princ "\n选择要加中心线的圆、圆弧、椭圆、矩形!")
(if (setq ss (ssget (list(cons 0 "ARC,CIRCLE,ELLIPSE,LWPOLYLINE"))))
    (progn
      (setq n (sslength ss) in 0)
      (repeat n
      (setq en (ssname ss in) in (1+ in))
      (setq endata (entget en))
      (setq entype (cdr (assoc 0 endata)))
      (cond
          ((or (= "CIRCLE" entype) (= "ARC" entype)) ;圆、圆弧
         (setq cenpt (cdr (assoc 10 endata)))
         (setq r (cdr (assoc 40 endata)))
         (setq dist (* r 0.4))
         (setq pt1 (polar cenpt pi (+ dist r))
               pt2 (polar cenpt 0 (+ dist r))
               pt3 (polar cenpt (* 0.5 pi) (+ dist r))
               pt4 (polar cenpt (* 1.5 pi) (+ dist r))
         )
          )
          ((= "ELLIPSE" entype) ;椭圆
         (setq cenpt (cdr (assoc 10 endata)))
         (setq l (distance (list 0 0) (cdr (assoc 11 endata))))
         (setq b (* (cdr (assoc 40 endata)) l))
         (setq rotangle (angle (list 0 0) (cdr (assoc 11 endata))))
         (setq dist (* b 0.4))
         (setq pt1 (polar cenpt rotangle (+ l dist))
               pt2 (polar cenpt (+ pi rotangle) (+ l dist))
               pt3 (polar cenpt (+ (* 0.5 pi) rotangle) (+ b dist))
               pt4 (polar cenpt (+ (* 1.5 pi) rotangle) (+ b dist))
         )
          )
          ((and (= "LWPOLYLINE" entype) (=(cdr (assoc 90 (entget en))) 4)) ;矩形
         (setq ptlist (vl-remove-if '(lambda (x) (/= 10 (car x))) endata))
         (setq ptlist (mapcar 'cdr ptlist)
               p1 (nth 0 ptlist)
               p2 (nth 1 ptlist)
               p3 (nth 2 ptlist)
               p4 (nth 3 ptlist)
         )
         (setq
               b (distance p1 p2)
               l (distance p1 p4)
               pt1 (MidPof2P p1 p2)
               pt2 (MidPof2P p3 p4)
               pt3 (MidPof2P p1 p4)
               pt4 (MidPof2P p2 p3)
         )
         (if (< b l)
               (setq dist (* b 0.2))
               (setq dist (* l 0.2))
         )
         (setq
               pt1 (polar pt1 (angle pt2 pt1) dist)
               pt2 (polar pt2 (angle pt1 pt2) dist)
               pt3 (polar pt3 (angle pt4 pt3) dist)
               pt4 (polar pt4 (angle pt3 pt4) dist)
         )
          )
      )
      (if (and pt1 pt2 pt3 pt4)
            (progn
            (if (not (tblsearch "LAYER" "Cen"))
                  (command "layer" "m" "Cen" "c" 2 "" "l" "center2" "" "lw"
                           0.18 "" "")
            )
            (command "layer" "s" "cen" "")
            (command "line" pt1 pt2 "")
            (command "line" pt3 pt4 "")
            (setvar "clayer" v3)
            )
       )
      )
    )
)
(setvar "osmode" v1)
(setvar "cmdecho" v2)
(princ)
)

smartstar 发表于 2012-4-28 06:13:00

手机上网,回头试用。

xiaoyingzi 发表于 2012-4-28 13:26:15

更新了下,支持椭圆

功夫佬 发表于 2012-4-30 20:54:08

这个是别人开发的智能中心线,目前还没发现谁上传像这样的中心线,本人以现还没有能力,但相信以后肯定能写出来,可惜没有参考,无法去研究。
页: 1 2 3 [4] 5 6
查看完整版本: 我写的加中心线的程序,可以加矩形、圆、平行线的