马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
本帖最后由 newer 于 2018-11-14 22:20 编辑
插入时候,可以动态的调整方向
命令:
〖移动〗插入点或{改基点[T]/改转角[R]/转90度[A]/对齐[F]/回退[U]/}<退出>:
 - (defun XD::Var:getDrawingScale ( / e u)
- (setq e (xdrx_object_get "layer" "0"))
- (setq #XD_Var_Global_Draw_Scale (car (xdrx_object_getxdata e "#XD_Var_Global_Draw_Scale")))
- (if (not #XD_Var_Global_Draw_Scale)
- (progn
- (if (= 0 (XD::Registry:GetVar "DrawingUnit"))
- (progn
- (XD::Var:SetDrawingScale 1000)
- (setq #XD_Var_Global_Draw_Scale 1000)
- )
- (progn
- (XD::Var:SetDrawingScale 100)
- (setq #XD_Var_Global_Draw_Scale 100)
- )
- )
- )
- )
- #XD_Var_Global_Draw_Scale
- )
- (defun c:XDTB_TXTINPUT (/ txt TxtBox txtH TxtHeight TxtInput)
- (defun *error* (msg)
- (princ msg)
- (xdrx_entity_delete etxt)
- (xdrx_end)
- )
- (defun c:Cancel_OnClicked (/) (dcl_Form_Close TxtInput))
- (defun c:TxtInput_OnInitialize (/)
- (dcl-control-setfocus TxtBox)
- (dcl_TextBox_SetSel TxtBox 0 -1)
- (dcl-Control-SetText TxtBox "")
- )
- (defun c:ok_OnClicked (/)
- (setq txt (dcl_Control_GetText TxtBox)
- txtH (dcl_ComboBox_GetEBText TxtHeight)
- )
- (if (/= "" txt)
- (progn (dcl_Form_Close TxtInput)
- (setq TxtH (* (xd::var:getdrawratio) (atof TxtH)))
- (setq etxt (xdrx_text_make '(0 0 0) txt txth (xdrx_vector_angle (getvar "ucsxdir"))))
- ;(xd::drag:simpleMove (entlast) "\n插入点:" 5 t)
- (if (not (XD::Pickset:Drag etxt (xdrx_getpropertyvalue etxt "9pt" 5) (+ 1 2 4 128) 0 nil))
- (xdrx_entity_delete etxt)
- )
- )
- (progn (dcl_MessageBox "文字不能为空.\n" "温馨提示")
- (dcl_TextBox_SetSel TxtBox 0 -1)
- )
- )
- )
- (xdrx_sysvar_push '("osmode" 0 "cmdecho" 0 "orthomode" 0))
- (if (XD::Doc:AutoLoadOpenDCL)
- (progn (dcl_Project_Load
- (*ODCL:Samples:FindFile "XDOB_DCL.odcl")
- t
- )
- (dcl_Form_Show TxtInput)
- )
- )
- (setq *error* nil)
- (xdrx_end)
- (xdrx_sysvar_pop)
- (princ)
- )
|