gyxzzza 发表于 2003-8-7 21:26:00

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

加载后命令行输入bzb
(defun C:bzb (/ texthigh p1 p2 x yh h0 textx texty texttextlongtextend) ;标二维坐标
(setq        h0
       (vl-registry-read
           "HKEY_CURRENT_USER\\Test"
           "h0"))
(if (noth0)
    (setq h0 (vl-registry-write
      "HKEY_CURRENT_USER\\Test"
      "h0"
      "1")))
(setqmessage (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请选择文字位置:"))

(whilep1
(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 " )"))
(setqtextlong (* (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

(setqtextlong (* (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)
      )

龙龙仔 发表于 2003-8-8 12:26:00

本帖最后由 作者 于 2003-8-8 13:37:27 编辑

改用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 发表于 2003-8-10 10:35:00

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

龙龙仔 发表于 2003-8-11 08:09:00

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

LIULISHENG 发表于 2021-7-8 14:46:02

感谢分享
页: [1]
查看完整版本: 1个小程序：坐标标注(二维型)