1个小程序：坐标标注(二维型)

gyxzzza

加载后命令行输入bzb
(defun C:bzb (/ texthigh p1 p2 x y  h h0 textx texty text  textlong  textend) ;标二维坐标
(setq        h0
         (vl-registry-read
           "HKEY_CURRENT_USER\\Test"
           "h0"))
  (if (not  h0)
    (setq h0 (vl-registry-write
      "HKEY_CURRENT_USER\\Test"
      "h0"
      "1")))
  (setq  message (strcat "\n请输入适当的字体大小" ":<" h0 ">"))
  (setq h (getstring message))
  (if  (eq h "")
   
(setq h (vl-registry-read
               "HKEY_CURRENT_USER\\Test"
               "h0"))
    (vl-registry-write
      "HKEY_CURRENT_USER\\Test"
      "h0"
      h)            
   
)
(setq texthigh (atof h))
   
  (setq p1 (getpoint "\n请选择要的标注点:"))
  (setq p2 (getpoint p1 "\n请选择文字位置:"))
  
  (while  p1
  (setq x (car p1))
  (setq y (cadr p1))
  (setq textx (rtos x 2 3))
  (setq texty (rtos y 2 3))
            
  (setq text (strcat "( " textx " , " texty " )"))
  (setq  textlong (* (strlen text) texthigh 0.85))
  (if ( > (car p2) (car p1))
    (progn
  (command "text" (polar p2 1.071 (* texthigh 0.5)) texthigh "0" text)
  
  (setq textend (polar p2 0 textlong))
  (command "pline" p1 p2 textend  "" )
      )
     (progn
  
  (setq  textlong (* (strlen text) texthigh 0.85))

  
  (setq textend (polar p2 pi textlong))
  (command "pline" p1 p2 textend  "" )
   (command "text" (polar textend 1.071 (* texthigh 0.5)) texthigh "0" text)  
     )
     )
  (setq p1 (getpoint "\n请选择要的标注点:"))
  (setq p2 (getpoint p1 "\n请选择文字位置:"))
    )
  (princ)
      )

龙龙仔

改用LEADER來做會更簡單一點!

  (defun C:TT (/ P1 P2 X Y TEXTX TEXTY TEXT)
  (while (and (setq P1 (getpoint "\n请选择要的标注点: "))
              (setq P2 (getpoint P1 "\n请选择文字位置: "))
         )
    (setq X (car P1))
    (setq Y (cadr P1))
    (setq TEXTX (rtos X 2 3))
    (setq TEXTY (rtos Y 2 3))
    (setq TEXT (strcat "( " TEXTX " , " TEXTY " )"))
    (command "_.LEADER" P1 P2 "A" TEXT "")
  )
)

congcong

你的程序简直太差劲了，如果有三百个孔要标注的话岂不是要标一天，而且可能还会标重复。

龙龙仔

我想這個程序不是用來标注孔的.

LIULISHENG

感谢分享