（2024.05.23日更新）晓东工具箱（For ACAD2004-2025）提供下载

lmchgs

请问工具箱加到天正建筑中能否冲突

newer

lmchgs 发表于 2017-3-31 14:21

只有装过你才知道。

lmchgs

请问最新工具箱有没有建筑图轴线开关循环命令，最早挂在cad2002上面是有的

newer

lmchgs 发表于 2017-3-31 16:00

如果没找到的话，可以去编程申请里面，去附个图，提交个申请，写是很容易的。

lmchgs

win7--32位--cad2007
加载自定义文件成功。自定义组: ACAD
加载自定义文件成功。自定义组: CUSTOM
加载自定义文件成功。自定义组: XDSOFT
正在重生成模型。
正在初始化 VBA 系统...
D:\XDSoft\Sys\XDRx.2007.arx 是无效 ARX 文件。
正在重生成模型。

newer

lmchgs 发表于 2017-3-31 21:13

去网上搜索 微软常用运行库 Microsoft Visual C++ 2005 SP1 安装下，你系统的运行库应该版本不对。

newer

lmchgs 发表于 2017-3-31 21:13

给你个地址：https://www.3987.com/xiazai/1/15/579.html

libefra

感谢分享，下载

lmchgs

谢谢了，按照你说的可以加载在cad2007，与天正建筑不冲突的，试用一下套内面积标注不了
套内面积为：101630.5 平方米.
标注文字插入点:; 错误: no function definition: xdrx_mleader_make
第二个问题，因为经常用到建筑描图，需要轴线反复快速循环开关，怎么把晓东的一起lsp加进去，下面是你的源码，谢谢了
;|轴线工具:
   "axcha" "maxcha" "chdote" "axerase" "axtrim" "axonf" "axvsb"
   "axis_qchg" "dote2swl" "mh_axis" "dotearea" "caxcha" "dsym_ro"
|;
(defun c:axcha (/ ss e nb1 nb2 ac n sty cstl str)
  (xdrx_begin)
  (while (setq e (car (entsel "\n请点一下要改变编号的轴线号 <退出>: ")))
    (xdrx_setenttodb e)
    (if        (and (setq str (xdrx_getentdxf 2))
             (wcmatch str "_AXISO*")
        )
      (progn
        (xdrx_getpolyvtx)
        (setq nb1 (xdrx_getentdxf 1)
              nb2 (getstring T (strcat "\n轴线编号将改成 <" nb1 ">: "))
        )
        (if (and (/= "" nb2)
                 (/= nb1 nb2)
            )
          (progn
            (setq n 1)
            (while (> 160
                      (setq ac (ascii (substr nb2 n)))
                      0
                   )
              (setq n (1+ n))
            )
            (if        (> ac 160)
              (progn
                (setq sty "HZ_COMPLEX")
                (if (and (not (tblsearch "style" sty))
                         (xdrx_findshx "hztxt.shx")
                    )
                  (progn
                    (if        (not _cfgdata)
                      (progn
                        (_@ld "loadcfg")
                        (loadcfg)
                      )
                    )
                    (setq cstl (getvar "textstyle"))
                    (command ".style"
                             sty
                             (strcat (nth 16 _cfgdata) ",hztxt")
                             ""
                             ""
                             ""
                             ""
                             ""
                    )
                    (dstop)
                    (setvar "textstyle" cstl)
                  )
                )
              )
              (setq sty "COMPLEX")
            )
            (xdrx_modent 1 nb2 7 sty)
            (entmod (list (cons -1 e)))
          )
        )
      )
    )
  )
  (xdrx_end)
)
(defun maxcha1 (n l / n1 n2 n3 nn ll tf)
  (if (and (setq n1 (maxcha2))
           (if (= "-" (substr n 1 1))
             (setq n2 "-"
                   n
                      (substr n 2)
             )
             (setq n2 "")
           )
           (setq n3 (maxcha2))
      )
    (progn
      (while (and (setq ll (car l))
                  (or (and (= 3
                              (setq tf (/= (type (read n1))
                                           (type (read
                                                   (car ll)
                                                 )
                                           )
                                       )
                                    nn (caddr ll)
                              )
                           )
                           (or (/= n1 n3) tf)
                      )
                      tf
                      (/= (type (read n3)) (type (read (cadr ll))))
                      (/= (if (last ll)
                            "-"
                            ""
                          )
                          n2
                      )
                  )
             )
        (setq l (cdr l))
      )
      (if ll
        (list ll
              (if (= 1 nn)
                (if (numberp (setq n2 (read n1)))
                  n2
                  (- 47 (length (member n1 lbb)))
                )
                (if (numberp (setq n2 (read n3)))
                  n2
                  (- 47 (length (member n3 lbb)))
                )
              )
              (if (= 1 nn)
                n3
                n1
              )
        )
      )
    )
  )
)
(defun maxcha2 (/ nx i)
  (if (= "" n)
    (setq nx "")
    (progn
      (setq i 1)
      (while (numberp (read (substr n i 1)))
        (setq i (1+ i))
      )
      (if (> i 1)
        (setq nx (substr n 1 (1- i))
              n         (substr n i)
        )
        (if (member (setq nx (substr n 1 1))
                    lbb
            )
          (setq n (substr n 2))
          (setq nx nil)
        )
      )
    )
  )
  nx
)
(defun maxcha3 (n i)
  (if (numberp (read n))
    (itoa i)
    (if        (> i 46)
      ""
      (nth (1- i) lbb)
    )
  )
)
(defun maxcha4 ()
  (setq        nb2 (getstring T
                       (strcat "\n轴线编号 " nb1 " 将改成 <" nb1 ">: ")
            )
        nb2 (if        (> (strlen nb2) 1)
              nb2
              (strcase nb2)
            )
  )
  (and (/= "" nb2)
       (/= nb1 nb2)
  )
)
(defun maxcha5 (ll l / n n1 n2)
  (setq        n  (caddr l)
        n1 (cadr ll)
        n2 (cadr ll)
  )
  (if (= 1 (logand 1 n))
    (setq n1 (maxcha3 (car l) (car ll)))
  )
  (if (= 2 (logand 2 n))
    (setq n2 (maxcha3 (cadr l) (car ll)))
  )
  (strcat n1
          (if (last l)
            "-"
            ""
          )
          n2
  )
)
(defun c:maxcha
       (/ ss e l1 ll ll1 lbb lnb lnb1 lnb2 nb0 nb1 nb2 i fn tf)
  (if
    (progn
      (princ "\n请选取要改变编号的轴线号 <退出>: ")
      (setq ss (ssget '((2 . "_AXISO*"))))
    )
     (progn
       (xdrx_begin)
       (setq lbb '("A"         "B"   "C"   "D"   "E"         "F"   "G"   "H"
                   "J"         "K"   "L"   "M"   "N"         "P"   "Q"   "R"
                   "S"         "T"   "U"   "V"   "W"         "X"   "Y"   "a"
                   "b"         "c"   "d"   "e"   "f"         "g"   "h"   "j"
                   "k"         "l"   "m"   "n"   "p"         "q"   "r"   "s"
                   "t"         "u"   "v"   "w"   "x"         "y"
                  )
             fn         (open (strcat _prefix1 "axisnb.dat") "r")
       )
       (if fn
         (progn
           (read-line fn)
           (while (setq x (read-line fn))
             (setq lnb (append lnb (read (strcat "(" x ")"))))
           )
           (close fn)
         )
         (princ        (strcat        "\n*** 没有找到轴线号定义文件 '"
                        _prefix
                        "axisnb.dat'."
                )
         )
       )
       (setq lnb (cons '("1" "" 1 nil) (cons '("A" "" 1 nil) lnb)))
       (xdrx_setsstodb ss 0)
       (while (setq e (xdrx_getentdata 0))
         (xdrx_getpolyvtx)
         (if (setq nb1        (xdrx_getentdxf 1)
                   lnb2        (maxcha1 nb1 lnb)
             )
           (setq nb1 (car lnb2)
                 ll  (assoc nb1 l1)
                 nb2 (append (cdr lnb2) (list e))
                 l1  (if ll
                       (subst (append ll (list nb2)) ll l1)
                       (cons (list nb1 nb2) l1)
                     )
           )
           (if (maxcha4)
             (progn
               (xdrx_modent 1 nb2)
               (entmod (list (cons -1 e)))
             )
           )
         )
       )
       (foreach        ll l1
         (setq lnb1 (car ll)
               ll   (apply 'xdrx_rlistsort1 (cdr ll))
         )
         (while        (and ll
                     (not (and (setq nb1 (maxcha5 (car ll) lnb1))
                               (/= nb1 nb0)
                               (setq tf (maxcha4))
                               (setq lnb2 (maxcha1 nb2 lnb))
                          )
                     )
                )
           (if (or tf (= nb1 nb0))
             (progn
               (setq e (last (car ll)))
               (xdrx_setenttodb (entnext e))
               (xdrx_modent 1 nb2)
               (entmod (list (cons -1 e)))
             )
             (setq nb2 nb1)
           )
           (setq nb0 nb1
                 ll  (cdr ll)
           )
         )
         (if ll
           (progn
             (setq i (- (cadr lnb2) (caar ll)))
             (foreach ll1 ll
               (setq nb2 (maxcha5 (list        (+ (car ll1) i)
                                        (last lnb2)
                                  )
                                  (car lnb2)
                         )
               )
               (xdrx_setenttodb (entnext (setq e (last ll1))))
               (xdrx_modent 1 nb2)
               (entmod (list (cons -1 e)))
             )
           )
         )
       )
       (xdrx_end)
     )
  )
  (princ)
)
(defun c:chdote        (/ ss ctla la lts lts1 l tf tf1)
  (setq        lts  (* 1000 (xdrx_srchdim "normal"))
        ctla (xdrx_getlyrname "*轴线")
        l    (tblnext "layer" T)
        tf1  T
  )
  (setvar "regenmode" 1)
  (command ".layer")
  (while l
    (if        (wcmatch (setq la (cdr (assoc 2 l)))
                 ctla
        )
      (progn
        (setq tf (= "DOTE" (cdr (assoc 6 l))))
        (if (and tf1
                 (not tf)
            )
          (progn
            (setq lts1 (getreal        (strcat "\n线型比例 <" (rtos lts 2 0) ">: ")
                       )
                  tf1  nil
            )
            (setvar "ltscale"
                    (if        lts1
                      lts1
                      lts
                    )
            )
          )
        )
        (command "l"
                 (if tf
                   ""
                   "dote"
                 )
                 la
        )
        (if
          (and tf
               (setq ss (ssget "X" (list (cons 8 la) '(6 . "DOTE*"))))
          )
           (progn
             (xdrx_setsstodb ss 0)
             (while (xdrx_getentdata 0)
               (xdrx_modent 6 "BYLAYER")
             )
           )
        )
      )
    )
    (setq l (tblnext "layer"))
  )
  (command "")
  (princ)
)
(defun c:axerase (/ ss)
  (princ "\n请选取要擦除的轴线 <退出>: ")
  (if (setq ss (ssget (list (cons 8 (xdrx_getlyrname "*轴线,*轴标")))))
    (command ".erase" ss "")
  )
  (princ)
)
(defun c:axtrim
       (/ axicut ss ss1 e i p1 p2 p3 x1 x2 y1 y2 a w wpl le ln)
  (defun axicut        (ln / ll n p0 ss e e0)
    (setq ll (list '(0 . "LINE,ARC")
                   (cons 8 (xdrx_getlyrname "*轴线,*轴标"))
             )
          n  (length ln)
          p0 (mapcar '/ (apply 'mapcar (cons '+ ln)) (list n n))
          ss (ssget "WP" ln ll)
    )
    (if        ss
      (command ".erase" ss "")
    )
    (if        (setq ss (ssget "CP" ln ll))
      (progn
        (apply 'command (append '(".pline") ln '("c")))
        (setq e0 (entlast))
        (command ".trim" e0 "")
        (xdrx_setsstodb ss 0)
        (while (setq e (xdrx_getentdata 0))
          (command (list e p0))
        )
        (command "")
        (entdel e0)
      )
    )
  )
  (xdrx_begin "0")
  (setvar "osmode" 512)
  (initget "W F M")
  (cond
    ((not (setq        p1
                 (getpoint
                   "\n请点取要剪裁轴线或剪裁边界第一点/ W-窗口/ F-边界/ M-门窗/ <退出>: "
                 )
          )
     )
    )
    ((= "W" p1)
     (if (and (setq p1 (getpoint "\n剪裁窗口的第一点 <退出>: "))
              (setq p2 (getcorner p1 "\n第二点 <退出>: "))
         )
       (progn
         (setq p3 (list p1 p2)
               p1 (mapcar 'car p3)
               p2 (mapcar 'cadr p3)
               x1 (apply 'min p1)
               x2 (apply 'max p1)
               y1 (apply 'min p2)
               y2 (apply 'max p2)
               ln (list        (list x1 y1)
                        (list x1 y2)
                        (list x2 y2)
                        (list x2 y1)
                  )
         )
         (axicut ln)
       )
     )
    )
    ((= "F" p1)
     (_@ld "dwgcut")
     (if (setq ln (manuline1 nil))
       (axicut ln)
     )
    )
    ((= "M" p1)
     (if (setq i  0
               ss (ssget "X"
                         (list '(0 . "INSERT")
                               (cons 8
                                     (xdrx_getlyrname "门窗")
                               )
                         )
                  )
         )
       (progn
         (setq ln
                (list '(0 . "LINE,ARC") (cons 8 (xdrx_getlyrname "轴线")))
         )
         (xdrx_setsstodb ss 0)
         (while        (xdrx_getentdata 0)
           (if (setq p1        (xdrx_getentdxf 10)
                     x1        (xdrx_getentdxf 41)
                     y1        (xdrx_getentdxf 42)
                     a        (xdrx_getentdxf 50)
                     w        (car (xdrx_getxdata "wthick"))
               )
             (progn
               (if (setq i   (1+ i)
                         w   (/ w 2)
                         wpl (xdrx_getxdata "wpline")
                   )
                 (setq wpl (xdrx_rtow p1 a x1 y1 wpl)
                       p2  (car wpl)
                       p3  (last wpl)
                       a   (angle p2 p3)
                 )
                 (setq x2 (/ x1 2)
                       p2 (polar p1 a (- x2))
                       p3 (polar p1 a x2)
                 )
               )
               (setq a (+ a _pi2))
               (if (setq ss1 (ssget "F"
                                    (list (polar p2 a (- w))
                                          (polar p2 a w)
                                    )
                                    ln
                             )
                   )
                 (progn
                   (xdrx_setsstodb ss1 1)
                   (while (setq e (xdrx_getentdata 1))
                     (command ".break" (list e p2) p3)
                   )
                 )
               )
               (if (setq ss1 (ssget "F"
                                    (list (polar p3 a (- w))
                                          (polar p3 a w)
                                    )
                                    ln
                             )
                   )
                 (progn
                   (xdrx_setsstodb ss1 1)
                   (while (setq e (xdrx_getentdata 1))
                     (command ".break" (list e p3) p2)
                   )
                 )
               )
             )
           )
         )
       )
     )
     (if (= i 0)
       (princ "\n没有找到要剪裁轴线的门窗。")
       (princ (strcat "\n已打断了" (itoa i) "个门窗上的轴线。"))
     )
    )
    ((and (if (takeout p1 "*轴线,*轴标" 5)
            (setq e (xdrx_getentdata 5))
            (setq p2 (getpoint p1 "\n剪裁边界的第二点 <退出>: "))
          )
          (setq p3 (getpoint "\n再点出剪裁方向 <退出>: "))
     )
     (setvar "osmode" 0)
     (if e
       (setq le        (list e)
             p2        (polar p1 (+ (angle p1 p3) (/ pi 2)) 1)
       )
       (if (setq ss (ssget "F"
                           (ltoecs (list p1 p2))
                           (list (cons 8
                                       (xdrx_getlyrname
                                         "*轴线,*轴标"
                                       )
                                 )
                           )
                    )
           )
         (progn
           (xdrx_setsstodb ss 0)
           (while (setq e (xdrx_getentdata 0))
             (setq le (cons e le))
           )
           (setq p3 (polar p3
                           (angle (inters p1
                                          p2
                                          p3
                                          (polar p3
                                                 (+ (/ pi 2)
                                                    (angle p1 p2)
                                                 )
                                                 1e3
                                          )
                                          nil
                                  )
                                  p3
                           )
                           1e6
                    )
           )
         )
       )
     )
     (if le
       (progn
         (command ".line" p1 p2 "")
         (setq e (entlast))
         (command ".trim" e "")
         (foreach e1 le (command (list e1 p3)))
         (command "")
         (entdel e)
       )
     )
    )
  )
  (xdrx_end)
)
(defun c:axonf (/ ldt lad lat na ll l1 l2 tf1 tf2)
  (setq        ldt (xdrx_getlyrname "*轴线")
        lad (xdrx_getlyrname "*轴标")
        lat "AXIS_TEXT"
        ll
            (tblnext "layer" T)
  )
  (while ll
    (setq na (cdr (assoc 2 ll)))
    (cond
      ((wcmatch na ldt)
       (setq tf1 (> (cdr (assoc 62 ll)) 0)
             l1         (cons na l1)
       )
      )
      ((wcmatch na lad)
       (setq tf2 (> (cdr (assoc 62 ll)) 0)
             l2         (cons na l2)
       )
      )
    )
    (setq ll (tblnext "layer"))
  )
  (if (or l1 l2)
    (progn
      (setvar "expert" 1)
      (command ".layer")
      (cond
        (tf1
         (foreach na l1 (command "of" na))
         (princ "\n'轴线'层已经关闭!")
        )
        (tf2
         (foreach na l2 (command "of" na))
         (command "of" lat)
         (princ
           "\n'轴标'层已经关闭!"
         )
        )
        (T
         (foreach na l1 (command "on" na))
         (foreach na l2 (command "on" na))
         (command "on" lat)
         (princ "\n'轴线'和'轴标'层已经打开!")
        )
      )
      (command "")
      (setvar "expert" 0)
    )
  )
  (princ)
)
(defun c:axvsb (/ ss e)
  (princ "\n请选取要改变可见性的轴线号 <退出>: ")
  (if (setq ss (ssget '((2 . "_AXISO*"))))
    (progn
      (xdrx_begin)
      (xdrx_setsstodb ss 0)
      (while (and (setq e (xdrx_getentdata 0))
                  (xdrx_getpolyvtx)
             )
        (xdrx_modent
          70
          (if (= 0 (xdrx_getentdxf 70))
            1
            0
          )
        )
        (entmod (list (cons -1 e)))
      )
      (xdrx_end)
    )
  )
  (princ)
)
;|
   命令：axis_qchg
   功能：把选取的轴符放大指定的倍数
        轴标图层：中文索引“轴标”对应英文层名在layerdef.dat里面定义
        默认和天正建筑相同（自己可以修改定义适合自己的习惯的图层）
        
   说明：1、问题提出是有时候轴符很长，默认的轴圈半径下不能很好的显示，所以希望能
        有个程序自动的把选取的轴圈依据自身的圆心和轴标分界线的端点为基础缩放轴
        圈。
        
        2、程序能很好的缩放，缩放后，圆心移动，但是轴符园和直线的端点处始终保持不
           变。
           
        3、程序配合XDRX_API使用，朋友们可以把这个LISP拷贝到“晓东工具箱”的安装的
          LISP目录，自己加入到菜单里面就可以非常方便的使用了。
          关于程序的建议请到“晓东CAD空间-编程申请”论坛
          http://www.xdcad.com/forum留言         
              
|;

(defun c:axis_qchg (/ lyr ss scl e box ins ss e1 int1 int2 nearpt)
  (xdrx_begin)
  (xdrx_ucson)
  (setq lyr (xdrx_getlyrname "轴标"))
  (if (not (setq ss (ssget (list (cons 8 lyr) '(0 . "insert")))))
    (setq ss (ssget "x" (list (cons 8 lyr) '(0 . "insert"))))
  )
  (if (setq scl (getreal "\n请输入缩放比例<退出>:"))
    (progn
      (xdrx_setsstodb ss 0)
      (while (setq e (xdrx_getentdata 0))
        (setq box (xdrx_entity_box e)
              box (cons (car box) (reverse box))
              ins (xdrx_getentdxf 10)
              ss  (ssget "cp" box (list (cons 8 lyr) '(0 . "line")))
        )
        (if (= 1 (sslength ss))
          (progn
            (setq e1   (ssname ss 0)
                  int1 (car (xdrx_getinters (cons (last box) box) e1))
            )
            (command ".scale" e "" ins scl)
            (setq box (xdrx_entity_box e)
                  box (cons (last box) box)
            )
            (setq int2         (xdrx_getinters box e1 2)
                  nearpt (apply
                           'xdrx_getnearpt
                           (cons int1 int2)
                         )
                  int2         (car nearpt)
            )
            (command ".move" e "" int2 int1)
          )
        )
      )
    )
  )
  (xdrx_ucsoff)
  (xdrx_end)
  (princ)
)

;| 命令：caxcha
轴号块图层：中文索引名"轴标",对应英文层名"axis"
若分区，用"-"作为分隔符号，输入*-A,则依次改为*-A,*-B,*-C...
"*"代表任何字符串。
轴号字母不管输入大小写，都改成大写。
对于字母，程序符合制图规范，去掉了I,O,Z
|;

(defun c:caxcha        (/ axl ss e ax_lyr tf no ptmin lbb prefix isnum no1)
  (defun isnum (no)
    (= no (itoa (atoi no)))
  )
  (if (progn
        (prompt "\n请选取要改变的轴线号<退出>:")
        (setq
          ss (ssget
               (list (cons 8 (xdrx_getlyrname "轴标")) '(0 . "insert"))
             )
        )
      )

    (progn
      (xdrx_begin)
      (xdrx_ucson)
      (xdrx_setsstodb ss 0)
      (setq ptmin (getvar "extmin"))
      (setq lbb        '("A"        "B"   "C"   "D"          "E"        "F"   "G"   "H"          "J"
                  "K"        "L"   "M"   "N"          "P"        "Q"   "R"   "S"          "T"
                  "U"        "V"   "W"   "X"          "Y"
                 )
      )
      (setq prefix "")
      (while (setq e (xdrx_getentdata 0))
        (setq
          axl (cons (list (distance (xdrx_getentdxf 10) ptmin) e) axl)
        )
      )
      (setq axl        (mapcar
                  'cadr
                  (apply
                    'xdrx_rlistsort1
                    axl
                  )
                )
      )
      (xdrx_setenttodb (car axl))
      (xdrx_nextent)
      (setq no (xdrx_getentdxf 1))
      (setq no (strcase
                 (getstring (strcat "\n把轴线号 " no " 改为<退出>:"))
               )
      )
      (if (/= no "")
        (progn
          (setq        prefix (xdrx_string_split no "-")
                no1    (last prefix)
                prefix (xdrx_string_subst "" (strcat "-" no1) no)
                no     no1
          )
          (if (not prefix)
            (setq prefix "")
            (setq prefix (strcat prefix "-"))
          )
          (if (not (isnum no))
            (progn
              (setq no (substr (xdrx_string_reverse no) 1 1))
              (if (not (isnum no))
                (progn
                  (setq tf (- (length lbb) (length (member no lbb))))
                )
              )
            )
          )
          (foreach n axl
            (xdrx_setenttodb n)
            (xdrx_nextent)
            (xdrx_modent 1 (strcat prefix no))
            (entupd n)
            (setq no (if tf
                       (nth (setq tf (1+ tf))
                            lbb
                       )

                       (itoa (1+ (atoi no)))
                     )
            )
          )
        )
      )
      (xdrx_ucsoff)
      (xdrx_end)
    )
  )
  (princ)
)
;;标题: 【解决方案】(api b10518)“轴线面积”，搜索轮廓线API应用，轴线必须连通，如何出挑无所谓，窗口选轴线能求出建筑的轴线总面积和房间的轴线面积，对于房间，要选取组成房间的轴线...

;;内容:
(defun c:dotearea (/ ss pl area tf high pt tf)
  (prompt "\n请用窗口选取要统计轴线面积的轴线<退出>:")
  (if (setq ss (ssget (list '(0 . "line") (cons 8 (xdrx_getlyrname "轴线")))))
    (progn
      (setq pl (xdrx_searchoutline ss))
      (setq lxd pl)
      (if pl
    (progn
      (apply
        'xdrx_grdraw
        (append
          (list 2 3)
          pl
        )
      )
      (setq area (abs (apply
                'xdrx_parea
                pl
              )
            )
      )
      (prompt (setq area (strcat "\n轴线面积:" (rtos area 2 2) " 平方米")))
      (initget 6 "Yes No")
      (setq tf (getkword "\n是否标在图上[Yes No]<No>:"))
      (if (not tf)
        (setq tf "No")
      )
      (if (= tf "Yes")
        (progn
          (initget 6)
          (setq high (getreal "\n请输入字高<500>:"))
          (if (not high)
        (setq high 500.0)
          )
          (initget 1)
          (setq pt (getpoint "\n请点取标注位置:"))
          (command ".text" pt high "" area)
        )
      )
    )
      )
    )
  )
  (princ)
)
;;;轴线美化，命令：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_getoffsetcurve e mmw)
        (reverse(xdrx_getoffsetcurve 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))
      (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)
)
;;;轴线生单线墙
;;;命令dote2swl
;;;适合任意的直线轴网和弧线轴网
;;;轴线图层为：中文索引“轴线”，英文层名：“dote”，实体为line

(defun c:dote2swl (/ ss dote_lyr ptll ptlarc s1 s2 dote_sort1 ptbase
            dote_line dote_arc dote_makess draw_line draw_arc
          )
  (defun dote_sort1 (ptbase ptl / pl)
    (if (> (length ptl) 1)
      (progn
    (setq pl (mapcar
          'cadr
          (apply
            'xdrx_rlistsort2
            (mapcar
              '(lambda (x)
              (list (distance x ptbase) x)
            )
              ptl
            )
          )
         )
    )
    (list (car pl) (last pl))
      )
    )
  )
  (defun dote_arc (s2 / e cp r ans ane p10 p11 ptl ptz s1 ptlarc)
    (xdrx_setsstodb s2 0)
    (while (setq e (xdrx_getentdata 0))
      (setq cp (xdrx_getentdxf 10)
        r (xdrx_getentdxf 40)
        ans (xdrx_getentdxf 50)
        ane (xdrx_getentdxf 51)
        p10 (polar cp ans r)
        p11 (polar cp ane r)
        ptl (xdrx_getsamplept e)
        s1 (ssget "f" ptl (list (cons 8 dote_lyr) '(0 . "line,arc")))
      )
      (if (and
        s1
        (> (sslength s1) 2)
      )
    (progn
      (setq ptl (xdrx_getinters e s1)
        ptbase (polar (car ptl) (angle (car ptl) (last ptl)) 1e10)
        ptz (polar cp (/ (+ (angle cp (car ptl)) (angle cp
                                (last ptl)
                             )
                 ) 2
                  ) r
            )
        ptl (dote_sort1 ptbase ptl)
        ptlarc (cons (list (car ptl) ptz (last ptl)) ptlarc)
      )
    )
      )
    )
    ptlarc
  )
  (defun dote_line (s1 / e p10 p11 an ptbase ptl ptll)
    (xdrx_setsstodb s1 0)
    (while (setq e (xdrx_getentdata 0))
      (setq p10 (xdrx_getentdxf 10)
        p11 (xdrx_getentdxf 11)
        an (angle p10 p11)
        ptbase (polar p10 an 1e10)
        ptl (xdrx_getinters e s1)
        ptll (cons (dote_sort1 ptbase ptl) ptll)
      )
    )
    ptll
  )
  (defun dote_makess (ss / s1 s2)
    (xdrx_setsstodb ss 0)
    (setq s1 (ssadd)
      s2 (ssadd)
    )
    (while (setq e (xdrx_getentdata 0))
      (if (= "LINE" (xdrx_getentdxf 0))
    (ssadd e s1)
    (ssadd e s2)
      )
    )
    (list s1 s2)
  )
  (defun draw_line (ptll / n)
    (foreach n ptll
      (apply
    'xdrx_line1
    n
      )
    )
  )
  (defun draw_arc (ptlarc / n)
    (foreach n ptlarc
      (apply
    'command
    (cons "arc" n)
      )
    )
  )
  (prompt "\n请选取要生成单墙的轴线<全选>:")
  (if (not (setq ss (ssget (list (cons 8 (setq dote_lyr
                          (xdrx_getlyrname "轴线")
                     )
                 ) '(0 . "line,arc")
              )
            )
      )
      )
    (setq ss (ssget "x" (list (cons 8 dote_lyr) '(0 . "line,arc"))))
  )
  (xdrx_begin "单墙")
  (xdrx_ucson)
  (mapcar
    'set
    '(s1 s2)
    (dote_makess ss)
  )
  (setq ptll (dote_line s1))
  (setq ptlarc (dote_arc s2))
  (draw_line ptll)
  (draw_arc ptlarc)
  (xdrx_ucsoff)
  (xdrx_end)
  (princ)
)
;|
   命令：dsym_ro
   功能：将天正系列软件的轴圈符号按照自身的插入点
        根据指定的角度旋转（轴号层AXIS,INSERT实体）
        
        
   说明：1.程序考虑了可以手工输入角度值，也可以根据屏幕的两点
          定角度。
        2.角度输入DEC度，逆时针为正
        3.程序考虑了用户坐标系，和一次性UNDO
   
   配合XDRX_API使用
   对程序有好的建议，请到“晓东CAD空间－论坛“留言
   http://www.xdcad.com/forum
|;

(defun c:dsym_ro (/ $getangle ss an e)
  (defun $getangle (/ p1 p2 an)
    (initget 2 "F")
    (setq an (getreal "\n请输入旋转的角度[F-两点定角度]<退出>"))
    (if (= "F" an)
      (progn
        (prompt "\n**请逆时针点取两点决定角度**")
        (initget 6)
        (setq p1 (getpoint "\n起点:")
              p2 (getpoint p1 "\n终点:")
              an (atof (angtos (- (angle p1 p2) (/ pi 2)) 0 4))
        )
      )
    )
    an
  )
  (if (and
        (setq an ($getangle))
        (progn
          (prompt "\n请选取要旋转的轴圈<退出>:")
          (setq ss (ssget '((8 . "axis") (0 . "insert"))))
        )
      )

    (progn
      (xdrx_begin)
      (xdrx_ucson)
      (xdrx_setsstodb ss 0)
      (while (setq e (xdrx_getentdata 0))
        (command ".rotate" e "" (xdrx_getentdxf 10) (rtos an 2 4))
      )
      (xdrx_ucsoff)
      (xdrx_end)
    )
  )
  (princ)
)
(defun c:XDTB_DoteTrim ()
;/ e1 e2 ss ptl1 pt p1 p2 pt1_1 pt1_2 intl1 intl2
;                          dis1 dis2 dis3 an
;                       )
  (setq dote_lyr (xdrx_getlyrname "轴线"))
  (prompt "\n请选取要裁剪的轴线<退出>:")
  (if (setq ss (ssget (list (cons 8 dote_lyr) '(0 . "line"))))
    (progn
      (xdrx_begin)
      (xdrx_pickset_redraw ss)
      (if (setq e1 (car (xdrx_entsel "\n请选择起始轴线<退出>:"
                                     (list (cons 8 dote_lyr) '(0 . "line"))
                        )
                   )
          )
        (progn
          (redraw e1 3)
          (setq ptl1 (list (xdrx_getentdxf 10) (xdrx_getentdxf 11)))
          (setq e2 (car (xdrx_entsel "\n请拾取结束轴线<结束>:"
                                     (list (cons 8 dote_lyr) '(0 . "line"))
                        )
                   )
          )
          (cond
            ((and
               e1
               e2
             )
              (redraw e2 3)
            )
            ((and
               e1
               (setq pt (getpoint "\n请点取裁剪方向<退出>:"))
             )
              (setq pt1 (cadr (xdrx_curve_closestpoint e1 pt))
                    an (angle pt1 pt)
              )
            )
          )
        )
      )
      (xdrx_setsstodb ss 0)
      (while (setq e (xdrx_getentdata 0))
        (setq intl1 (xdrx_getinters e1 e 0)
              pj1 (car intl1)
              pt1_1 (xdrx_getentdxf 10)
              pt1_2 (xdrx_getentdxf 11))
        (if intl1
          (progn
            (if (and
                  e2
                  (setq intl2 (car (xdrx_getinters e2 e 0)))
                )
              (progn
                (setq an (angle intl2 pj1))
                (setq p2 (polar intl2 an 1000.0))
                (setq p1 (polar pj1 an -1000.0))
              )
              (progn
                (setq p1 (polar pj1 an 1000.0))
                (setq dis1 (apply
                             'xdrx_p2ldist
                             (cons p1 ptl1)
                           )
                      dis2 (apply
                             'xdrx_p2ldist
                             (cons pt1_1 ptl1)
                           )
                      dis3 (apply
                             'xdrx_p2ldist
                             (cons pt1_2 ptl1)
                           )
                )
                (if (> (* dis1 dis2) 0)
                  (setq p2 pt1_1)
                  (setq p2 pt1_2)
                )
              )
            )
            (command ".break" (list e p1) p2)
          )
        )
      )
      (xdrx_pickset_redraw ss t)
      (redraw e1 4)
      (if e2
        (redraw e2 4)
      )
      (xdrx_end)
    )
  )
  (princ)
)

newer

lmchgs 发表于 2017-4-1 10:52

别在这发这样的帖子啊，去单独发个帖子吧。
另外，看下论坛置顶的帖子，看看如何贴LISP代码。

thg0088

win10，cad2007，安装工具箱提示未安装cad是什么情况？

abing214539880

谢谢楼主分享！

cpiner

谢谢楼主，以前用过3.0版本

lijunfa12345

正需要，支持楼主大人了！

天空之哥8424

很好的工具箱，谢谢奉献