[LISP程序]：标注粗糙度的程序（原作小妹丁）

hyx_lyn

原作为小妹丁的，我对程序改了一下，希望大家多提意见
[php]
;;;一个新的粗糙度标注方式
;;;2004.10.06
;;;2004.11.16更改，更改人：hyx_lyn
(defun c:cud ()
  (defun myerror (msg)
    (setvar "osmode" os)                ;恢复捕捉
    (setq *error* olderr)                ;恢复原来的出错函数
    (princ)
  )
  (setq        olderr        *error*                        ;保存旧的
        *error*        myerror                        ;设置新的
  )
  (princ "可在空白处标注")
  (setq osm (getvar "osmode"))
  (setq cmd (getvar "cmdecho"))
  (setq dims (getvar "dimscale"))
  (setq h (getvar "dimtxt"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (vl-cmdf ".undo" "be")                ;设置后退的起始点
  (setq en (nentsel))
  (if en
    (progn
      (setq pt (osnap (cadr en) "nea"))
      (setq endata (entget (car en)))
      (setq xxob (cdr (assoc 0 endata)))
      (cond ((= xxob "LINE")                ;实体为LINE
             (culine pt endata)
            )
            ((or (= xxob "ARC") (= xxob "CIRCLE")) ;实体为ARC or CIRCLE
             (cuarc pt endata)
            )
            ((= xxob "LWPOLYLINE")        ;实体为LWPOLYLINE
             (vl-cmdf "explode" en)
             (setq enn (ssname (ssget pt) 0))
             (setq endata (entget enn))
             (culine pt endata)
            )
            (t (alert "对不起，暂未支持该实体类型。"))
      )
    )
    (progn                                ;未选取实体时，在空白处标注
      (setq pt (getpoint "在空白处确认标注位置："))
      (setq pt-0 (polar pt (/ pi 2) 10))
      (SETQ ang (ANGLE pt pt-0))
      (setq bx (getreal "\n粗糙度(非加工 0)<12.5>:"))
      (IF (= bx NIL)
        (SETQ bx 12.5)
      )
      (if (= bx 0)                        ;非加工标注
        (progn
          (SETQ cud_pt1 (POLAR pt (- ang (cud_dtr 30)) (* 3.0 h)))
          (SETQ cud_pt2 (POLAR pt ang (* 1.0 h)))
          (SETQ cud_pt3 (POLAR pt (+ ang (cud_dtr 30)) (* 1.5 h)))
          (vl-cmdf "PLINE" cud_pt3 "w" 0 "" pt cud_pt1 "")
          (vl-cmdf "circle" cud_pt2 (* 0.5 h))
        )
        (progn
          (cud_fuhao pt ang h)
          (setq bX (rtos bX 2 1))
          (setq px0 (polar pt (* pi 0.5) (* 2.0 h)))
          (setq angle_text 0)
          (vl-cmdf "text" "m" px0 (* h 1.0) angle_text bx "")
        )
      )
      (setq pxt (polar cud_pt3 pi (* 2.5 h)))
      (setq bxqu "其余")
      (vl-cmdf "text" "m" pxt (* h 2.5) 0 bxqu "")
    )
  )
  (setvar "cmdecho" cmd)
  (setvar "osmode" osm)
  (vl-cmdf ".undo" "e")                        ;设置结束
  (setq *error* olderr)                        ;恢复原来的出错函数
)
(princ "\n***CUD.小妹丁,2004.10.23***")
(princ "\n***CUD.hyx_lyn,2004.11.20***")
(princ)
;;;-------------------------------------------------------------
;;;实体为ARC or CIRCL
;;;-------------------------------------------------------------
(defun cuarc (pt engata)
  (setq arc_r (cdr (assoc 40 endata)))        ;取得半径
  (setq arc_p0 (cdr (assoc 10 endata)))        ;取得圆心
  (setq ptf (getpoint pt "\n指向："))
  (setq angle_ptf (angle arc_p0 pt))
  (setq dis_ptf (distance arc_p0 ptf))
  (if (> dis_ptf arc_r)
    (progn
      (cud_fuhao pt angle_ptf h)
      (setq px0 (polar pt angle_ptf (* 2.0 h)))
      (setq angle_text (cud_rtd (+ (/ pi 2) angle_ptf)))
      (if (and (>= angle_ptf 0) (<= angle_ptf pi))
        (setq angle_text (+ 180 angle_text))
      )
      (setq bx (getREAL "\n粗糙度<3.2>:"))
      (IF (= bx NIL)
        (SETQ bx 3.2)
      )
      (setq bX (rtos bX 2 1))
      (vl-cmdf "text" "m" px0 (* h 1.0) angle_text bx "")
    )
    (progn
      (cud_fuhao pt (+ angle_ptf pi) h)
      (setq px0 (polar pt (+ angle_ptf pi) (* 2.0 h)))
      (setq angle_text (cud_rtd (+ (/ pi 2) angle_ptf)))
      (if (and (>= angle_ptf 0) (<= angle_ptf pi))
        (setq angle_text (+ 180 angle_text))
      )
      (setq bx (getREAL "\n粗糙度<3.2>:"))
      (IF (= bx NIL)
        (SETQ bx 3.2)
      )
      (setq bX (rtos bX 2 1))
      (vl-cmdf "text" "m" px0 (* h 1.0) angle_text bx "")
    )
  )
)
;;;-------------------------------------------------------------
;;;实体为LINE LWPOLYLINE
;;;-------------------------------------------------------------
(defun culine (pt endata)
  (setq ptf (getpoint pt "\n指向："))
  (setq pl1 (cdr (assoc 10 endata)))
  (setq pl2 (cdr (assoc 11 endata)))
  (setq langle12 (angle pl1 pl2))
  (setq langle21 (angle pl2 pl1))
  (if (> langle12 langle21)
    (setq angle_line
           langle21
          pl1 pl2
    )
    (setq angle_line langle12)
  )
  (setq angle_text (cud_rtd angle_line))
  (if (> angle_text 90)
    (setq angle_text (- angle_text 180))
  )
  (setq angle_ptf (angle pl1 ptf))
  (if (and (> angle_ptf angle_line)
           (< angle_ptf (+ angle_line pi))
      )
    (progn
      (cud_fuhao pt (+ (/ pi 2) angle_line) h)
      (setq px0 (polar pt (+ angle_line (/ pi 2)) (* 2.0 h)))
      (setq bx (getREAL "\n粗糙度<3.2>:"))
      (IF (= bx NIL)
        (SETQ bx 3.2)
      )
      (setq bX (rtos bX 2 1))
      (vl-cmdf "text" "m" px0 (* h 1.0) angle_text bx "")
    )
    (progn
      (cud_fuhao pt (- angle_line (/ pi 2)) h)
      (setq px0 (polar pt (- angle_line (/ pi 2)) (* 2.0 h)))
      (setq bx (getREAL "\n粗糙度<3.2>:"))
      (IF (= bx NIL)
        (SETQ bx 3.2)
      )
      (setq bX (rtos bX 2 1))
      (vl-cmdf "text" "m" px0 (* h 1.0) angle_text bx "")
    )
  )
)
;;;-------------------------------------------------------------
(defun cud_fuhao (IP IRA cud_k)
  (SETQ cud_pt1 (POLAR IP (- IRA (cud_dtr 30)) (* 3.0 cud_k)))
  (SETQ cud_pt2 (POLAR IP (- IRA (cud_dtr 30)) (* 1.5 cud_k)))
  (SETQ cud_pt3 (POLAR IP (+ IRA (cud_dtr 30)) (* 1.5 cud_k)))
  (vl-cmdf "PLINE" cud_pt2 "w" 0 "" cud_pt3 IP cud_pt1 "")
)
;;;-------------------------------------------------------------
(DEFUN cud_dtr (A)
  (* PI (/ A 180.0))
)
;;;-------------------------------------------------------------
(DEFUN cud_rtd (A)
  (* 180.0 (/ A pi))
)
[/php]

lsjjm

来个简单点的:
[PHP]
(defun c:test ()
  (setvar "osmode" 0)
  (setq p0 (getpoint "\nInput point"))
  (setq high (* (getvar "dimscale")(getvar "dimtxt")))
  (setq p1 (osnap p0 "near"))
  (if p1 (setq ang (angle p1 p0))(setq ang (/ pi 2) p1 p0))
  (if (or (null cvalue)(= cvalue ""))(setq cvalue "32"))
  (princ "\nInput Crudity Value <")
  (princ cvalue)
  (princ ">")
  (setq string (getstring))
  (if (or (null string)(= string ""))(setq string cvalue)(setq cvalue string))
  ;(mlayer "dim" "blue" "continuous")
  (vl-cmdf "pline" (polar p1 (- ang (/ pi 6))(/ high 0.3)) p1
                   (polar p1 (+ ang (/ pi 6))(/ high 0.6))
                   (Polar p1 (- ang (/ pi 6)) (/ high 0.6)) "")
  (if (and (< ang (/ (* pi 6) 7))(> ang (/ pi 6)))
    (setq d 1 p0 (polar p1 ang (/ high 0.55)))
    (setq d -1 p0 (polar p1 ang (/ high 0.35)))
  )
  (vl-cmdf "text" "j" "f" (polar p0 (+ ang (* d (/ pi 2))) high)
                          (polar p0 (- ang (* d (/ pi 2))) high) high string)
)
[/PHP]

小妹丁

楼主让我出丑了，不过你改造得更好。
我的LISP学得好烂，凑合自己玩下，现在也没时间碰了。
我记得发的是FAS文件，你也解得出，厉害。

hyx_lyn

小妹丁你好：
    你记错了，你发的是LISP文件。因为现在画图需要标注粗糙度所以前些日子在论坛中搜到的，用了一下觉得不错，只是有一些地方不太适合，所以未经你同意就改了一下，目的只是让我们作的更好而以。