[求助]：有没有画轴线的Lisp程序？

fundoll

有没有画轴线的Lisp程序？（如天正一样的）

netbee

我有，我就是看了天正的才编制。因为我不能为了绘制轴线就把天正都装上。不过我的可能要过一段时间才能上传

coolzhb

我们一直在等netbee的程序！

fundoll

期待中! 快点上传! 谢谢!

netbee

不好意思，我的软件是专业软件，已经在我的周围付费发行，所以，我要花一段时间开发共享版，将其中的有针对性的专业功能进行一定限制（为了公平嘛，不能说他们付了费，而我又在网上免费）。当然，大部份功能还是可以用的，特别是轴线绘制，我准备公开其源代码（其实就是天正建筑中5.0中公开的LISP啦）。
　　或者我只发行其中的某些功能模块。
　　当然，最主要的是我最近太忙了

fundoll

一个简单的画轴线程序

tuger

我给大家一个我的工具箱里的画轴线命令吧？和理正的有点象，有预览功能,需要的请到
www.kenro.533.net下载。

tsxljj

特别是轴线绘制，我准备公开其源代码（其实就是天正建筑中5.0中公开的LISP啦）。


期待。
如何从天正建筑中5.0提取出来？我试了几次都不行，谁能指教一下，谢谢了。

tuger

从天正5中提出的代码没用的，因为里面用了很多天正自己的核心函数，除非你自己写一个和他们的差不多的核心函数，这可能需要用c或vb写了，vlisp和lisp时写不了这样的核心函数

tsxljj

谢谢。
用lisp能做到象天正轴线那样的功能吗？
我非常喜欢天正的轴线、画墙、门窗功能，因为平常不怎么画立剖面。

usb

GI不能下

三根毛

tuger  ,不能下载啊

chstart

很棒！谢谢fundoll 。
贴出来分享。


(defun C:ax(/ lay len_x num_x test propt dis_x kj_x len_y num_y dis_y kj_y
              pt dis pt1 pt2 pt3 pt4 pt5 pt6 pt11 pt22 pth1 pth2 ptt ptz1
              ptz2 dx dxx dy dyy i txt dxt dyt)
   
   (setvar "CMDECHO" 0)
   (setq lay (getvar "clayer"))
   (command "color" "bylayer")
   (command "layer" "m" "dimax" "c" "g" "dimax" "lt" "continuous" "" "")
   (command "layer" "m" "axis" "c" "red" "axis" "lt" "点划线" "" "")
   (command "STYLE" "complex" "complex" "0" "1" "0" "n" "n" "n")
   (command "STYLE" "xw" "txt" "0" ".8" "0" "n" "n" "n")

   (setq len_x 0 num_x 1 test T)
     (while test
       (setq propt (strcat "请输入第" (itoa num_x) "开间尺寸<ENTER结束>: "))
       (initget 6)
       (setq dis_x (getreal propt))
       (if (= dis_x nil)
         (setq test nil)
         (progn
           (setq len_x (+ len_x dis_x))
           (if (= 1 num_x) (setq kj_x (list dis_x))
             (progn
               (setq kj_x (append kj_x (list dis_x)))
             )
           )
           (setq num_x (1+ num_x))
         )
       )
     )
   
   (setq len_y 0 num_y 1 test T)
     (while test
       (setq propt (strcat "请输入第" (itoa num_y) "进深尺寸<ENTER结束>: "))
       (initget 6)
       (setq dis_y (getreal propt))
       (if (= dis_y nil)
         (setq test nil)
         (progn
           (setq len_y (+ len_y dis_y))
           (if (= 1 num_y) (setq kj_y (list dis_y))
             (progn
               (setq kj_y (append kj_y (list dis_y)))
             )
           )
           (setq num_y (1+ num_y))
         )
       )
     )

   (setq pt (getpoint "\n请输入轴线左下角点<10000,10000>: "))
   (if (= pt nil) (setq pt '(10000 10000)))
   (setq dis (getreal "\n请输入轴线至尺寸线的距离<4500>: "))
   (if (= dis nil) (setq dis 5700) (setq dis (+ dis 1200)))  
   (setq pt1 pt)
      (setq dy (cadr pt1))
      (setq dx (car pt1))
      (setq dx (- dx dis))
      (setq dxx (+ dx len_x dis dis))
      (setq pt1 (list dx  dy))
      (setq pt2 (list dxx dy))
      (setq pt11 (list (+ dx  1200) dy))
      (setq pt22 (list (- dxx 1200) dy))
      (setq ptz1 (list (+ dx  500) dy))
      (setq ptz2 (list (- dxx 500) dy))
      (command "line" pt1 pt2 "")
      (command "layer" "s" "dimax" "")
      (command "circle" (list (- dx  400) dy) 400)
      (command "circle" (list (+ dxx 400) dy) 400)
      (setq pth1 (polar pt1 3.463 632.5))
      (setq pth2 (polar pt2 5.500 282.8))
      (command "text" "s" "complex" ^c)
      (command "text" "j" "f" pth1 (polar pth1 0 400) 400 "A")
      (command "text" "j" "f" pth2 (polar pth2 0 400) 400 "A")
      (command "text" "s" "xw" ^c)
      (command "layer" "s" "axis" "")
   (setq i 0)
   (repeat (- num_y 1)
      (setq dy (+ dy (nth i kj_y)))
      (setq pt1 (list dx dy))
      (setq pt2 (list dxx dy))
      (setq pt3 (list (+ dx  1200) dy))
      (setq pt4 (list (- dxx 1200) dy))
      (command "line" pt1 pt2 "")
      (command "layer" "s" "dimax" "")  
      (command "circle" (list (- dx  400) dy) 400)
      (command "circle" (list (+ dxx 400) dy) 400)
      (setq pth1 (polar pt1 3.463 632.5))
      (setq pth2 (polar pt2 5.500 282.8))
      (command "text" "s" "complex" ^c)
      (cond ((= 0 i) (setq txt "B"))
            ((= 1 i) (setq txt "C"))
            ((= 2 i) (setq txt "D"))
            ((= 3 i) (setq txt "E"))
            ((= 4 i) (setq txt "F"))
            ((= 5 i) (setq txt "G"))
            ((= 6 i) (setq txt "H"))
            ((= 7 i) (setq txt "J"))
            ((= 8 i) (setq txt "K"))
            ((= 9 i) (setq txt "L"))
            ((= 10 i) (setq txt "M"))
            ((= 11 i) (setq txt "N"))
            ((= 12 i) (setq txt "P"))
            ((= 13 i) (setq txt "Q"))
            ((= 14 i) (setq txt "R"))
            ((= 15 i) (setq txt "S"))
            ((= 16 i) (setq txt "T"))
            ((= 17 i) (setq txt "U"))
            ((= 18 i) (setq txt "V"))
            ((= 19 i) (setq txt "W"))
            ((= 20 i) (setq txt "X"))
            ((= 21 i) (setq txt "Y"))
            ((= 22 i) (setq txt "Z"))
      )
      (command "text" "j" "f" pth1 (polar pth1 0 400) 400 txt)
      (command "text" "j" "f" pth2 (polar pth2 0 400) 400 txt)
      (command "text" "s" "xw" ^c)      
      
      (command "line" pt11 pt3 "")
      (if (= 0 i)
        (progn
          (setq pt5 (polar pt11 (* pi 1.75) 70.7))
          (setq pt6 (polar pt5 (* pi 0.75) 141.4))
          (command "pline" pt5 "w" 50 50 pt6 "")
        )
      )
      (setq pt5 (polar pt3 (* pi 1.75) 70.7))
      (setq pt6 (polar pt5 (* pi 0.75) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq dyt (cadr pt11))
      (setq dxt (car pt11))
      (setq ptt (list (- dxt 115) (+ dyt (/ (nth i kj_y) 2))))
      (command "text" "c" ptt 300 90 (rtos (nth i kj_y) 2 0))
      (setq pt11 pt3)

      (command "line" pt22 pt4 "")
      (if (= 0 i)
        (progn
          (setq pt5 (polar pt22 (* pi 1.75) 70.7))
          (setq pt6 (polar pt5 (* pi 0.75) 141.4))
          (command "pline" pt5 "w" 50 50 pt6 "")
        )
      )
      (setq pt5 (polar pt4 (* pi 1.75) 70.7))
      (setq pt6 (polar pt5 (* pi 0.75) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq dyt (cadr pt22))
      (setq dxt (car pt22))
      (setq ptt (list (- dxt 115) (+ dyt (/ (nth i kj_y) 2))))
      (command "text" "c" ptt 300 90 (rtos (nth i kj_y) 2 0))
      (setq pt22 pt4)
      
      (command "layer" "s" "axis" "")  
      (setq i (+ i 1))
   )
      (command "layer" "s" "dimax" "")
      (command "line" ptz1 (polar ptz1 (* pi 0.5) len_y) "")
      (setq pt5 (polar ptz1 (* pi 1.75) 70.7))
      (setq pt6 (polar pt5 (* pi 0.75) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq ptz1 (polar ptz1 (* pi 0.5) len_y))
      (setq pt5 (polar ptz1 (* pi 1.75) 70.7))
      (setq pt6 (polar pt5 (* pi 0.75) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq dyt (cadr ptz1))
      (setq dxt (car ptz1))
      (setq ptt (list (- dxt 115) (- dyt (/ len_y 2))))
      (command "text" "c" ptt 300 90 (rtos len_y 2 0))
      
      (command "line" ptz2 (polar ptz2 (* pi 0.5) len_y) "")
      (setq pt5 (polar ptz2 (* pi 1.75) 70.7))
      (setq pt6 (polar pt5 (* pi 0.75) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq ptz2 (polar ptz2 (* pi 0.5) len_y))
      (setq pt5 (polar ptz2 (* pi 1.75) 70.7))
      (setq pt6 (polar pt5 (* pi 0.75) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq dyt (cadr ptz2))
      (setq dxt (car ptz2))
      (setq ptt (list (- dxt 115) (- dyt (/ len_y 2))))
      (command "text" "c" ptt 300 90 (rtos len_y 2 0))

   (command "layer" "s" "axis" "")
   (setq pt1 pt)                   ;Y向轴线
      (setq dy (cadr pt1))
      (setq dx (car pt1))
      (setq dy (- dy dis))
      (setq dyy (+ dy len_y dis dis))
      (setq pt1 (list dx dy))
      (setq pt2 (list dx dyy))
      (setq pt11 (list dx (+ dy  1200)))
      (setq pt22 (list dx (- dyy 1200)))
      (setq ptz1 (list dx (+ dy  500)))
      (setq ptz2 (list dx (- dyy 500)))
      (command "line" pt1 pt2 "")
      (command "layer" "s" "dimax" "")
      (command "circle" (list dx (- dy  400)) 400)
      (command "circle" (list dx (+ dyy 400)) 400)
      (setq pth1 (polar pt1 4.391 632.5))
      (setq pth2 (polar pt2 2.356 282.8))
      (command "text" "s" "complex" ^c)
      (command "text" "j" "f" pth1 (polar pth1 0 400) 400 "1")
      (command "text" "j" "f" pth2 (polar pth2 0 400) 400 "1")
      (command "text" "s" "xw" ^c)
      (command "layer" "s" "axis" "")
   (setq i 0)
   (repeat (- num_x 1)
      (setq dx (+ dx (nth i kj_x)))
      (setq pt1 (list dx dy))
      (setq pt2 (list dx dyy))
      (setq pt3 (list dx (+ dy  1200)))
      (setq pt4 (list dx (- dyy 1200)))
      (command "line" pt1 pt2 "")
      (command "layer" "s" "dimax" "")  
      (command "circle" (list dx (- dy  400)) 400)
      (command "circle" (list dx (+ dyy 400)) 400)
      (setq pth1 (polar pt1 4.391 632.5))
      (setq pth2 (polar pt2 2.356 282.8))
      (command "text" "s" "complex" ^c)
      (command "text" "j" "f" pth1 (polar pth1 0 400) 400 (rtos (+ i 2) 2 0))
      (command "text" "j" "f" pth2 (polar pth2 0 400) 400 (rtos (+ i 2) 2 0))
      (command "text" "s" "xw" ^c)
      
      (command "line" pt11 pt3 "")
      (if (= 0 i)
        (progn
          (setq pt5 (polar pt11 (* pi 1.25)  70.7))
          (setq pt6 (polar pt5  (* pi 0.25) 141.4))
          (command "pline" pt5 "w" 50 50 pt6 "")
        )
      )
      (setq pt5 (polar pt3 (* pi 1.25) 70.7))
      (setq pt6 (polar pt5 (* pi 0.25) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq dyt (cadr pt11))
      (setq dxt (car pt11))
      (setq ptt (list  (+ dxt (/ (nth i kj_x) 2)) (+ dyt 115)))
      (command "text" "c" ptt 300 0 (rtos (nth i kj_x) 2 0))
      (setq pt11 pt3)

      (command "line" pt22 pt4 "")
      (if (= 0 i)
        (progn
          (setq pt5 (polar pt22 (* pi 1.25) 70.7))
          (setq pt6 (polar pt5 (* pi 0.25) 141.4))
          (command "pline" pt5 "w" 50 50 pt6 "")
        )
      )
      (setq pt5 (polar pt4 (* pi 1.25) 70.7))
      (setq pt6 (polar pt5 (* pi 0.25) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq dyt (cadr pt22))
      (setq dxt (car pt22))
      (setq ptt (list (+ dxt (/ (nth i kj_x) 2)) (+ dyt 115)))
      (command "text" "c" ptt 300 0 (rtos (nth i kj_x) 2 0))
      (setq pt22 pt4)
      
      (command "layer" "s" "axis" "")  
      (setq i (+ i 1))
   )

      (command "layer" "s" "dimax" "")                ;标注总尺寸
      (command "line" ptz1 (polar ptz1 0 len_x) "")
      (setq pt5 (polar ptz1 (* pi 1.25) 70.7))
      (setq pt6 (polar pt5 (* pi 0.25) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq ptz1 (polar ptz1 0 len_x))
      (setq pt5 (polar ptz1 (* pi 1.25) 70.7))
      (setq pt6 (polar pt5 (* pi 0.25) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq dyt (cadr ptz1))
      (setq dxt (car ptz1))
      (setq ptt (list (- dxt (/ len_x 2)) (+ dyt 115)))
      (command "text" "c" ptt 300 0 (rtos len_x 2 0))
      
      (command "line" ptz2 (polar ptz2 0 len_x) "")
      (setq pt5 (polar ptz2 (* pi 1.25) 70.7))
      (setq pt6 (polar pt5 (* pi 0.25) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq ptz2 (polar ptz2 0 len_x))
      (setq pt5 (polar ptz2 (* pi 1.25) 70.7))
      (setq pt6 (polar pt5 (* pi 0.25) 141.4))
      (command "pline" pt5 "w" 50 50 pt6 "")
      (setq dyt (cadr ptz2))
      (setq dxt (car ptz2))
      (setq ptt (list (- dxt (/ len_x 2)) (+ dyt 115)))
      (command "text" "c" ptt 300 0 (rtos len_x 2 0))

   (command "layer" "s" lay "")
   (command "zoom" "e")
   (princ "\n应使用<<改轴线线型>>将轴线线型由点划线改为连续,出图前")
   (princ "\n再使用此功能改回.否则在以后的操作中可能捕捉不到轴线交点!")
   (princ)
)

netbee

呵呵！
已经上传：
http://www.xdcad.net/forum/showt ... y=&pagenumber=1