[LISP程序]：给天正系列软件增加"美化轴线"的命令,出图时候运行,可以把没有

木桂水

赞成dancingbubble 的建议“建议斑竹对要付爱心币软件进行评价”，这样爱心币才可以用地点子上。
好主意。不然经常有误下的时候。

leo108

有用哦！！好！！

gxghj

用在什么版本

GUAN-G

谢谢各位了。

jianwang72

怎么用

xmllin

有谁试过，好不好用，解说一下。

chm

楼主确实很厉害呀

wzq-130

*-*3 我用的是天正6.0版的，支持吗？

iceredtea

我加载后，命令可用了。但是可能是我理解不对，斑竹说要出图时运行，我是随便画了一个土（符合要求），然后用该命令，结果是所有的轴线（包括有墙线的）都没有了。请问可以帮忙解答吗？

bjxxyy

下载的不是程序呀！是这些：;;;轴线美化，命令：mh_axis
;;;出图时候，可以把图中所有没有墙线的轴线裁减掉。
;;; 可以通过修改程序中的变量mma，设定裁减后的轴线挑出长度
;;; 可以通过修改程序中的变量mmw, 设定捕捉轴线两侧的墙线宽度范围大小
;;; 本程序适用于正交轴网

(defun c:mh_axis (/ ask_int en_l int_l pt_min1 pt_min2 pt_max1 pt_max2 mma
                    mmw p_sort_x p_sort_y ask_int1 ask_int re_sort_list
                    re_sort_list1 pro_axis axis_del tfz
                 )
  (defun isvalid_dote (e /  ss)
    (setq ptl (append
                (xdrx_curve_offset e mmw)
                (reverse(xdrx_curve_offset e (- mmw)))
              )
    )
    (if (and
          (setq ss (ssget "wp" ptl (list (cons 8 wal_lyr) '(0 . "line"))))
          (> (sslength ss) 1)
        )
      t
      (progn
        (entdel e)
        nil
      )
    )
  )
  (defun ask_int (/ ss en en_l int_l ptl)
    (prompt "\n请选取要美化的天正轴线<ALL>:")
    (if (not (setq ss (ssget (list (cons 8 (xdrx_getlyrname "轴线")) '
                                   (0 . "LINE")
                             )
                      )
             )
        )
      (setq ss (ssget "x" (list (cons 8 (xdrx_getlyrname "轴线")) '
                                (0 . "LINE")
                          )
               )
      )
    )
    (xdrx_setsstodb ss 0)
    (while (setq e (xdrx_getentdata 0))
      (if (isvalid_dote e)
        (progn
          (setq ptl (append
                      (list (xdrx_getentdxf 10) (xdrx_getentdxf 11))
                      ptl
                    )
          )
        )
      )
    )
    (setq dote_box (apply
                     'xdrx_pointsbox
                     ptl
                   )
    )
    (setq int_l (xdrx_getinters ss))
  )
  (defun re_sort_list (int_l pt1 pt2 / p_d_l n p_l_list old)
    (setq p_d_l nil)
    (foreach n int_l
      (setq p_l_dist (xdrx_p2ldist n pt1 pt2)
            p_l_dist (fix (+ 0.5 p_l_dist))
      )

      (if (setq old (assoc p_l_dist p_d_l))
        (progn
          (setq p_d_l (subst
                        (cons p_l_dist (cons n (cdr old)))
                        old
                        p_d_l
                      )
          )
        )
        (progn
          (setq p_d_l (cons (list p_l_dist n) p_d_l))
        )
      )
    )
    (apply
      'xdrx_rlistsort1
      p_d_l
    )
  )
  (defun re_sort_list1 (int_l min1 min2 max1 max2)
    (mapcar
      '(lambda (x1)
         (mapcar
           'cadr
           x1
         )
       )
      (mapcar
        '(lambda (x1)
           (re_sort_list x1 min1 min2)
         )
        (mapcar
          'cdr
          (re_sort_list int_l max1 max2)
        )
      )
    )
  )
  (defun axis_del (ss / ss e)
    (xdrx_setsstodb ss 0)
    (while (setq e (xdrx_getentdata 0))
    (princ "\nfafaf")
      (if (< (distance (xdrx_getentdxf 10) (xdrx_getentdxf 11)) (+ 1100 mma))
        (entdel e)
      )
    )
  )
  (defun pro_axis (pl / n p1 p2 p11 p22 ss)
    (foreach n pl
      (while (cdr n)
        (setq p1 (car n)
              p2 (cadr n)
              n (cdr n)
        )
        (setq an (angle p1 p2)
              p11 (polar p1 an mma)
              p22 (polar p2 an (- mma))
        )
        (if (and
              (xdrx_getptss p11 100 "轴线" 1)
              (xdrx_getptss p22 100 "轴线" 2)
              (equal (setq e1 (xdrx_getentdata 1))
                     (xdrx_getentdata 2)
              )
              (not (or
                     (xdrx_getptss p11 mmw "墙线")
                     (xdrx_getptss p22 mmw "墙线")
                   )
              )
            )
          (progn
            (command "break" (list e1 p11) p22)
          )
        )
      )
    )
  )                                       ; Main Program
  (xdrx_begin)
  (xdrx_ucson)
  (setq dote_lyr (xdrx_getlyrname "轴线")
        wal_lyr (xdrx_getlyrname "墙线,单墙")
        mma 500                               ; 轴线挑出长度
        mmw 300                               ; 半墙宽

  )
  (if (setq int_l (ask_int))
    (progn
      (if (setq tfz (apply
                      'xdrx_isptoffscr
                      dote_box
                    )
          )
        (xdrx_zoomw (car dote_box) (caddr dote_box))
      )

      (setq pt_min1 (car dote_box)
            pt_min2 (polar pt_min1 (/ pi 2) 10)
            pt_max1 (caddr dote_box)
            pt_max2 (polar pt_max1 0 10)
      )
      (setq p_sort_x (re_sort_list1 int_l pt_min1 pt_min2 pt_max1 pt_max2))
      (setq p_sort_y (re_sort_list1 int_l pt_max1 pt_max2 pt_min1 pt_min2))
      (pro_axis p_sort_x)
      (pro_axis p_sort_y)
      (axis_del (ssget "x" (list (cons 8 (xdrx_getlyrname "轴线")) '
                                 (0 . "LINE")
                           )
                )
      )
      (if tfz
        (command "zoom" "p")
      )
    )
  )
  (xdrx_ucsoff)
  (xdrx_end)
  (princ)
)

iceredtea

我下的是*.lisp阿，我是直接点击存的。

limingqian

曾经用过小东工具箱中美化轴线的命令,但是有时不能有效地完成

hawk500

不行啊，tch6.5下，轴线全没了！！！

hhy1985

先下了再说

iceredtea

楼上hawk500跟我的问题一样啊，请高手指点，谢谢！