[LISP函数]：做了一画剖面符号的程序请大家指教

yjtdkj · 发表于 2004-12-10 22:34:32

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本人做了一画剖面符号的程序，带有预先指示方向功能，但是输入终点的时候不能使用正交、极轴、捕捉的功能，还请大家赐教！！
------------------------------------------------------------------------------
2004-12-15[/COLOR]
感谢xyp1964的支持，改变了设计思路，重新上传了一个,下载请到9楼，[/COLOR]

LADESIGNER · 发表于 2004-12-11 20:08:34

太复杂，看起来太费事。还是属性块简单一些。

urljit · 发表于 2004-12-13 13:18:39

grread期间恐怕不能使用捕捉等,我曾经发过贴,没有人回答,现在只好认为是不能捕捉了.

yjtdkj · 发表于 2004-12-14 21:06:04

请问还有好办法没有？比如这样：在选取剖面符号的两个定位点后，再提示选取一点来判断投影方向，就像OFFSET命令一样，

xyp1964 · 发表于 2004-12-14 21:39:55

对grread不熟悉，看看这个原始的：

yjtdkj · 发表于 2004-12-14 21:50:13

非常感谢你的指导，我的水平还不够，还得研究一阵子

urljit · 发表于 2004-12-15 07:19:39

最初由 yjtdkj 发布
[B]请问还有好办法没有？比如这样：在选取剖面符号的两个定位点后，再提示选取一点来判断投影方向，就像OFFSET命令一样， [/B]

可以使用对话框实现文字的位置交互,看看我的这个程序:
http://www.xdcad.net/forum/showthread.php?s=&threadid=309611

nore · 发表于 2004-12-15 16:45:04

两位的都下载了，回去好好看看，学一点思路

yjtdkj · 发表于 2004-12-15 18:53:48

感谢xyp1964的支持，改变了设计思路，重新上传了一个，和大家交流一下，如果觉得可以就支持我一下吧

[FONT=courier new]
(defun pset (sym do str / @@@)
(princ (strcat str "<"))
(princ (eval sym))
(setq @@@ (eval (do ">:")))
(if (or (not @@@) (equal @@@ ""))
(eval sym)
(set sym @@@)
) ;_ 结束if
) ;_ 结束defun
;;;----------------------------------------------------------------------------------------
(defun setlay (name color)
(if (tblsearch "layer" name)
(progn (command "layer" "s" name ""))
(progn (command "layer" "m" name "c" color "" ""))
) ;_ 结束if
) ;_ 结束defun
;;;----------------------------------------------------------------------------------------
(defun c:sectional (/ a ang dir h oldcla olderr oldosm
oldpli pt1 pt2 pt3 pt4 pt5 pt6
pt7 pt8 sc w whi ANG2 ANG3
ANG4 P3 P3A P3B PO3 PO3_1 PO3_2
PO3_3 PO4 PO4_1 PO4_2 PO4_3
) ;_ 结束/
(princ
"\n剖面&断面符号绘制小程序v1.0\n-----------------------yjtdkj8156262@163.com-----------------------"
) ;_ 结束princ
;;;---------------------------------------------------------------------------------------
(defun myerror (msg)
(if (= msg "函数被取消")
(princ "\n老大!干嘛取消呀？")
(princ "\n*******程序异常退出*******")
) ;_ 结束if
(setvar "osmode" oldosm) ;恢复捕捉
(setvar "plinewid" oldpli) ;恢复多义线宽
(setvar "CLAYER" oldcla) ;恢复图层
(setq *error* olderr) ;恢复原来的出错函数
(princ)
) ;_ 结束defun
(setq olderr *error* ;保存旧的
*error* myerror ;设置新的
) ;_ 结束setq
(setq oldosm (getvar "osmode"))
(setq oldpli (getvar "plinewid"))
(setq oldcla (getvar "CLAYER"))
(command "_.undo" "_Group")
;;;----------------------------------------------------------------------------------------
(if (not #section_scale#);储存绘图比例的变量
(progn (setq #section_scale# 15);绘图比例默认值15
(setq sc #section_scale#)
) ;_ 结束progn
(setq sc #section_scale#)
) ;_ 结束if
(if (not #section_dir#);储存剖面(1)&断面(2)符号的变量
(progn (setq #section_dir# "1");剖面(1)&断面(2)符号默认值1
(setq dir #section_dir#)
) ;_ 结束progn
(setq dir #section_dir#)
) ;_ 结束if
;;;----------------------------------------------------------------------
(setq pt1 (getpoint "\n起点: "))
(princ (strcat "\n当前绘图比例1: "
(rtos #section_scale#)
" ; 当前剖面(1)&断面(2)符号: "
#section_dir#
) ;strcat
) ;princ
(while (not whi)
(initget 127 "S E W")
(setq pt2 (getpoint pt1 "\n指定终点或[绘图比例(S)/剖面&断面(E)]: "))
(cond
((equal pt2 "S")
(pset '#section_scale# getreal "\n请输入绘图比例")
(setq sc #section_scale#)
) ;cond #1
((equal pt2 "E")
(initget 0 "1 2")
(pset '#section_dir#
getkword
"\n请选择剖面(1)/断面(2)?"
) ;_ 结束pset
(setq dir #section_dir#)
) ;cond #2
((equal (type pt2) 'LIST)
(setq whi T)
) ;cond #4
(T
(princ
"\n无效输入. 需要一个点或设置默认值：绘图比例/剖面&断面."
) ;_ 结束princ
) ;cond #5
) ;cond close
) ;while
(grvecs (list 256 pt1 pt2))
;;;----------------------------------------------------------------------
(setq p3 (getpoint "\n点取剖视方向 : "))
(setq ang (angle pt1 pt2)
p3a (polar p3 (- ang (* pi 0.5)) 1000)
p3b (inters pt1 pt2 p3 p3a nil)
;dist (distance p3b p3)
ang2 (angle p3b p3)
ang3 (- ang ang2)
) ;_ 结束setq
(if (or (> ang3 0) (< ang3 (- 0 pi)))
(setq ang4 0)
(setq ang4 pi)
) ;_ 结束if
;;;----------------------------------------------------------------------
(setq
w (* 0.7 sc)
h (* 5 sc)
) ;_ 结束setq
(setq
po3 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 20 sc))
po4 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 20 sc))
po3_3 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 10 sc))
po4_3 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 10 sc))
po3_1 (polar po3_3 (+ ang (* 1.0 pi)) (* 2.8 sc))
po4_1 (polar po4_3 (+ ang (* 1.0 pi)) (* 2.8 sc))
po3_2 (polar po3_3 ang (* 2.8 sc))
po4_2 (polar po4_3 ang (* 2.8 sc))
) ;_ 结束setq
(grvecs (list 256 pt1 po3 256 pt2 po4 256 po3
po3_1 256 po3 po3_2 256 po3_1 po3_2 256
po4 po4_1 256 po4 po4_2 256 po4_1 po4_2
) ;_ 结束list
;_ 结束list
) ;_ 结束grvecs
;;;----------------------------------------------------------------------
(if (not #section_a#)
(setq #section_a# "1")
) ;_ 结束if
(pset '#section_a# getstring "\n输入剖面号")
(setq a #section_a#)
;;----------------------------------------------------------------------
(setvar "plinewid" w)
(setvar "osmode" 0)
;;----------------------------------------------------------------------
(cond ((eq dir "1")
(setq
pt3 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 4 sc))
pt4 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 4 sc))
pt5 (polar pt1 ang (* 6 sc))
pt6 (polar pt2 (+ ang (* 1.0 pi)) (* 6 sc))
pt7 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 8 sc))
pt8 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 8 sc))
) ;_ 结束setq
(setlay "PUB_DIM" 136)
(command "pline" pt5 pt1 pt3 "")
(command "pline" pt6 pt2 pt4 "")
(setlay "PUB_text" 7)
(command "text" "j" "mc" pt7 h "0" a)
(command "text" "j" "mc" pt8 h "0" a)
)
((eq dir "2")
(setq
pt3 (polar pt1 (+ ang (* 1.0 pi)) (* 4 sc))
pt4 (polar pt2 ang (* 4 sc))
pt5 (polar pt1 ang (* 4 sc))
pt6 (polar pt2 (+ ang (* 1.0 pi)) (* 4 sc))
pt7 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 4 sc))
pt8 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 4 sc))
) ;_ 结束setq
(setlay "PUB_DIM" 136)
(command "pline" pt5 pt3 "")
(command "pline" pt6 pt4 "")
(setlay "PUB_text" 7)
(command "text" "j" "mc" pt7 h "0" a)
(command "text" "j" "mc" pt8 h "0" a)
)
) ;_ 结束cond
;;-------------------------------------------------------------------------------
(command "_.undo" "_end")
(setq *error* olderr) ;正常结束程序时恢复默认
(setvar "osmode" oldosm)
(setvar "plinewid" oldpli)
(setvar "CLAYER" oldcla)
(princ
"\n谢谢使用!!--------------------------yjtdkj8156262@163.com"
) ;_ 结束princ
(PRINC)
) ;_ 结束defun
[/FONT]

[FONT=courier new] 
(defun pset (sym do str / @@@) 
  (princ (strcat str "<")) 
  (princ (eval sym)) 
  (setq @@@ (eval (do ">:"))) 
  (if (or (not @@@) (equal @@@ "")) 
    (eval sym) 
    (set sym @@@) 
  ) ;_ 结束if 
) ;_ 结束defun 
;;;---------------------------------------------------------------------------------------- 
(defun setlay (name color) 
  (if (tblsearch "layer" name) 
    (progn (command "layer" "s" name "")) 
    (progn (command "layer" "m" name "c" color "" "")) 
  ) ;_ 结束if 
) ;_ 结束defun 
;;;---------------------------------------------------------------------------------------- 
(defun c:sectional (/ a             ang    dir           h          oldcla olderr        oldosm 
                      oldpli pt1    pt2           pt3          pt4         pt5        pt6 
                      pt7    pt8    sc           w          whi         ANG2        ANG3 
                      ANG4   P3            P3A           P3B          PO3         PO3_1        PO3_2 
                      PO3_3  PO4    PO4_1  PO4_2  PO4_3 
                     ) ;_ 结束/ 
  (princ 
    "\n剖面&断面符号绘制小程序v1.0\n-----------------------yjtdkj8156262@163.com-----------------------" 
  ) ;_ 结束princ 
 
;;;--------------------------------------------------------------------------------------- 
  (defun myerror (msg) 
    (if        (= msg "函数被取消") 
      (princ "\n老大!干嘛取消呀？") 
      (princ "\n*******程序异常退出*******") 
    ) ;_ 结束if 
    (setvar "osmode" oldosm)                ;恢复捕捉 
    (setvar "plinewid" oldpli)                ;恢复多义线宽 
    (setvar "CLAYER" oldcla)                ;恢复图层 
    (setq *error* olderr)                ;恢复原来的出错函数 
    (princ) 
  ) ;_ 结束defun 
  (setq        olderr        *error*                        ;保存旧的 
        *error*        myerror                        ;设置新的 
  ) ;_ 结束setq 
  (setq oldosm (getvar "osmode")) 
  (setq oldpli (getvar "plinewid")) 
  (setq oldcla (getvar "CLAYER")) 
  (command "_.undo" "_Group") 
;;;---------------------------------------------------------------------------------------- 
  (if (not #section_scale#);储存绘图比例的变量 
    (progn (setq #section_scale# 15);绘图比例默认值15 
           (setq sc #section_scale#) 
    ) ;_ 结束progn 
    (setq sc #section_scale#) 
  ) ;_ 结束if 
  (if (not #section_dir#);储存剖面(1)&断面(2)符号的变量 
    (progn (setq #section_dir# "1");剖面(1)&断面(2)符号默认值1 
           (setq dir #section_dir#) 
    ) ;_ 结束progn 
    (setq dir #section_dir#) 
  ) ;_ 结束if 
;;;---------------------------------------------------------------------- 
  (setq pt1 (getpoint "\n起点: ")) 
  (princ (strcat "\n当前绘图比例1: " 
                 (rtos #section_scale#) 
                 " ; 当前剖面(1)&断面(2)符号: " 
                 #section_dir# 
 
         )                                ;strcat 
  )                                        ;princ 
  (while (not whi) 
    (initget 127 "S E W") 
    (setq pt2 (getpoint pt1 "\n指定终点或[绘图比例(S)/剖面&断面(E)]: ")) 
    (cond 
      ((equal pt2 "S") 
       (pset '#section_scale# getreal "\n请输入绘图比例") 
       (setq sc #section_scale#) 
      )                                        ;cond #1 
      ((equal pt2 "E") 
       (initget 0 "1 2") 
       (pset '#section_dir# 
             getkword 
             "\n请选择剖面(1)/断面(2)?" 
       ) ;_ 结束pset 
       (setq dir #section_dir#) 
      )                                        ;cond #2 
      ((equal (type pt2) 'LIST) 
       (setq whi T) 
      )                                        ;cond #4 
      (T 
       (princ 
         "\n无效输入. 需要一个点或设置默认值：绘图比例/剖面&断面." 
       ) ;_ 结束princ 
      )                                        ;cond #5 
    )                                        ;cond close 
  )                                        ;while 
(grvecs (list 256 pt1 pt2)) 
;;;---------------------------------------------------------------------- 
  (setq p3 (getpoint "\n点取剖视方向 : ")) 
  (setq        ang  (angle pt1 pt2) 
        p3a  (polar p3 (- ang (* pi 0.5)) 1000) 
        p3b  (inters pt1 pt2 p3 p3a nil) 
                                        ;dist (distance p3b p3) 
        ang2 (angle p3b p3) 
        ang3 (- ang ang2) 
  ) ;_ 结束setq 
  (if (or (> ang3 0) (< ang3 (- 0 pi))) 
    (setq ang4 0) 
    (setq ang4 pi) 
  ) ;_ 结束if 
;;;---------------------------------------------------------------------- 
  (setq 
    w (* 0.7 sc) 
    h (* 5 sc) 
 
  ) ;_ 结束setq 
  (setq 
    po3          (polar pt1 (+ ang (* 1.5 pi) ang4) (* 20 sc)) 
    po4          (polar pt2 (+ ang (* 1.5 pi) ang4) (* 20 sc)) 
    po3_3 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 10 sc)) 
    po4_3 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 10 sc)) 
    po3_1 (polar po3_3 (+ ang (* 1.0 pi)) (* 2.8 sc)) 
    po4_1 (polar po4_3 (+ ang (* 1.0 pi)) (* 2.8 sc)) 
    po3_2 (polar po3_3 ang (* 2.8 sc)) 
    po4_2 (polar po4_3 ang (* 2.8 sc)) 
  ) ;_ 结束setq 
 
  (grvecs (list        256    pt1    po3    256    pt2           po4          256         po3 
                po3_1  256    po3    po3_2  256           po3_1  po3_2         256 
                po4    po4_1  256    po4    po4_2  256          po4_1         po4_2 
               ) ;_ 结束list 
 ;_ 结束list 
  ) ;_ 结束grvecs 
   ;;;---------------------------------------------------------------------- 
 
  (if (not #section_a#) 
    (setq #section_a# "1") 
  ) ;_ 结束if 
  (pset '#section_a# getstring "\n输入剖面号") 
  (setq a #section_a#) 
  ;;---------------------------------------------------------------------- 
   
  (setvar "plinewid" w) 
  (setvar "osmode" 0) 
  ;;---------------------------------------------------------------------- 
  (cond        ((eq dir "1") 
         (setq 
           pt3 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 4 sc)) 
           pt4 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 4 sc)) 
           pt5 (polar pt1 ang (* 6 sc)) 
           pt6 (polar pt2 (+ ang (* 1.0 pi)) (* 6 sc)) 
           pt7 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 8 sc)) 
           pt8 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 8 sc)) 
         ) ;_ 结束setq 
         (setlay "PUB_DIM" 136) 
         (command "pline" pt5 pt1 pt3 "") 
         (command "pline" pt6 pt2 pt4 "") 
         (setlay "PUB_text" 7) 
         (command "text" "j" "mc" pt7 h "0" a) 
         (command "text" "j" "mc" pt8 h "0" a) 
        ) 
        ((eq dir "2") 
         (setq 
           pt3 (polar pt1 (+ ang (* 1.0 pi)) (* 4 sc)) 
           pt4 (polar pt2 ang (* 4 sc)) 
           pt5 (polar pt1 ang (* 4 sc)) 
           pt6 (polar pt2 (+ ang (* 1.0 pi)) (* 4 sc)) 
           pt7 (polar pt1 (+ ang (* 1.5 pi) ang4) (* 4 sc)) 
           pt8 (polar pt2 (+ ang (* 1.5 pi) ang4) (* 4 sc)) 
         ) ;_ 结束setq 
         (setlay "PUB_DIM" 136) 
         (command "pline" pt5 pt3 "") 
         (command "pline" pt6 pt4 "") 
         (setlay "PUB_text" 7) 
         (command "text" "j" "mc" pt7 h "0" a) 
         (command "text" "j" "mc" pt8 h "0" a) 
        ) 
  ) ;_ 结束cond 
  ;;------------------------------------------------------------------------------- 
  (command "_.undo" "_end") 
  (setq *error* olderr)                        ;正常结束程序时恢复默认 
  (setvar "osmode" oldosm) 
  (setvar "plinewid" oldpli) 
  (setvar "CLAYER" oldcla) 
  (princ 
    "\n谢谢使用!!--------------------------yjtdkj8156262@163.com" 
  ) ;_ 结束princ 
  (PRINC) 
) ;_ 结束defun 
 
 
 
  [/FONT]

xyp1964 · 发表于 2004-12-15 20:02:02

程序测试通过可以用。
改进：可以考虑增加类似“建施－1”的文本功能。

yjtdkj · 发表于 2004-12-15 22:02:21

这样的话就必须对“建施-5”等文本有个对齐方式的判断，不然的话文字很容易跑到剖切符号上去，你看看我的思路对不对？

xyp1964 · 发表于 2004-12-15 22:11:08

如果嫌程序判断麻烦，可以提示输入内容，再让用户指定放置位置。

aeo · 发表于 2004-12-15 22:23:11

没必要搞那么复杂，越复杂越不好用

其实预览过程就只要是画线（command "line") 这样中间undo就直接了
画完了，给个方向，改成剖切符号.

yjtdkj · 发表于 2004-12-15 22:28:19

那就须要在指定位置时对文字有个预览的功能了，我还比较菜，请大侠多多指教!!^_^

aeo · 发表于 2004-12-15 22:32:18

文字有个预览?
给完方向再文字吧，程序中难道还点出文字的点?
肯定是完了再调整一下.

账号		自动登录	找回密码
密码			立即注册

[LISP函数]：做了一画剖面符号的程序请大家指教

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块