请大家帮忙看一下这个程序是否有缺陷？

dwgplt · 发表于 2003-2-17 14:34:00

;;---------------------------------------------------
;;****此程序功能是对管道线进行管径标注，其符号为DN。
;;****只对直线有效
;;---------------------------------------------------
(defun C:BDN (/          CMD_OLD          OS_OLD SS       SS1       SS2 PT
            PT0 PT1 PT2          ANG       DN       DN0       BDN_ER BDN_OE
            VOBJ PNT PARAM1 PARAM2
         )
  (defun DXF (CODE ELIST)
(cdr (assoc CODE ELIST))
  )
  (defun DO_IT ()
(setq ANG0 (angle PT1 PT2))
(if
   (and (> ANG0 (* pi 0.5)) (:")))
(if
   (= DN "")
   (setq DN DN0)
   (setq DN0 DN)
)
(setq DN (strcat "DN" DN))
(command "_.text"
         "C"
         PT
         (getvar "textsize")
         (angtos ANG0 0 3)
         DN
)
  )
  (setq CMD_OLD (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq OS_OLD (getvar "osmode"))
  (setvar "osmode" 0)
  (defun BDN_ER       (S)
(if       (/= MSG "功能取消")
   (if (= MSG "退出 / 中止")
      (princ)
      (princ (strcat "\n功能取消!"))
   )
)
(eval (read U:E))
(if       BDN_OE
   (setq *ERROR* BDN_OE)
)
(if       temp
   (redraw temp 1)
)
(princ)
  )
  (if *ERROR*
(setq BDN_OE  *ERROR*
      *ERROR* BDN_ER
)
(setq *ERROR* BDN_ER)
  )
  (setq       U:G "(command \"undo\" \"group\")"
      U:E "(command \"undo\" \"en\")"
  )
  (while
(setq SS (entsel "\n请拾取需标注管径的管道:"))
   (setq SS1 (entget (car SS)))
   (setq SS2 (DXF 0 SS1))
   (setq PT (osnap (trans (cadr SS) 1 0) "MID"))
   (cond
   ((= SS2 "LINE")
      (setq PT1 (DXF 10 SS1)
            PT2 (DXF 11 SS1)
      )
      (DO_IT)
   )
   ((or (= SS2 "LWPOLYLINE")
         (= SS2 &quotOLYLINE")
      )
      (setq VOBJ (vlax-ename->vla-object (car SS)))
      (setq PARAM1 (vlax-curve-getparamatpoint VOBJ PT))
      (setq PARAM1 (fix PARAM1))
      (setq PARAM2 (1+ PARAM1))
      (if (equal PARAM1 (vlax-curve-getstartparam VOBJ) 1e-10)
      (setq PT1 (vlax-curve-getstartpoint VOBJ))
      (setq PT1 (vlax-curve-getpointatparam VOBJ PARAM1))
      )
      (if (equal PARAM2 (vlax-curve-getendparam VOBJ) 1e-10)
      (setq PT2 (vlax-curve-getendpoint VOBJ))
      (setq PT2 (vlax-curve-getpointatparam VOBJ PARAM2))
      )
      (DO_IT)
   )
   (t
      (alert "\n所选像素不能进行管径标注!重新选取")
   )
   )
  )
  (setvar "cmdecho" CMD_OLD)
  (setvar "osmode" OS_OLD)
  (princ)
)
(prompt "\nEnter BDN to start")

dwgplt · 发表于 2003-2-19 14:14:00

很想学学习

请大家帮忙看一下这个程序是否有缺陷？

发表回复

精选推荐

浏览过的版块