1. edges
2. two point
(defun c:XDTB_BottomRec (/ distx disty dynpt e h i
kword p1 p2 pmid pt2 pt3 pt-3
pts ret1 seg tbox tf tf2 tf3
txt1 txt2 txtp v w xdir ydir
)
(defun _keyword (keyword)
(redraw)
(cond ((= keyword "A") (xdrx-setvar "distancesnap" 0))
((= keyword "S") (xdrx-setvar "distancesnap" 1))
((= keyword "D") (xdrx-setvar "distancesnap" 5))
((= keyword "F") (xdrx-setvar "distancesnap" 10))
((= keyword "G")
(if (setq v (getreal (xdrx-prompt
(xdrx-string-multilanguage
"\n输入步长<" "\nInput Step Size<")
(xdrx-getvar "distancesnap")
">:"
t
)
)
)
(xdrx-setvar "DistanceSnap" (abs v))
)
)
((= keyword "W")
(if (setq w (getreal (xdrx_prompt
(xdrx-string-multilanguage
"\n输入线宽度<"
"\nInput Constant Width<"
)
#xd-var-global-line-width
">:"
t
)
)
)
(progn (xd::var:set "#xd-var-global-line-width" w)
(setq #xd-var-global-line-width
(atof #xd-var-global-line-width)
)
(xdrx_setpropertyvalue
(entlast)
"constantwidth"
#xd-var-global-line-width
"color"
#xd-var-global-ent-color
)
)
)
)
((= keyword "C")
(if (setq w (getint (xdrx_prompt
(xdrx-string-multilanguage
"\n输入颜色号<" "\nInput Color Index<")
#xd-var-global-ent-color
">:"
t
)
)
)
(progn (xd::var:set "#xd-var-global-ent-color" w)
(setq #xd-var-global-ent-color
(atoi #xd-var-global-ent-color)
)
(xdrx_setpropertyvalue
(entlast)
"constantwidth"
#xd-var-global-line-width
"color"
#xd-var-global-ent-color
)
)
)
)
;;; ((= keyword "U")
;;; (if (> i 0)
;;; (progn (xd::doc:command (list ".undo" 2))
;;; (setq i (1- i))
;;; (if (= i 0)
;;; (xdrx_prompt "\n所有回退已经完成.")
;;; )
;;; )
;;; (xdrx_prompt "\n所有回退已经完成.")
;;; )
;;; )
)
(_prompt1)
)
(defun _callback (dynpt)
(redraw)
(setq xdir (xdrx-vector-normalize (mapcar '- p2 p1))
xdir (if (setq tf3 (< (car xdir) 0.0))
(xdrx-vector-negate xdir)
xdir
)
ydir (xdrx-vector-perpvector xdir)
distx (xdrx-point-dist2line dynpt (list p1 (mapcar '+ ydir)))
disty (xdrx-point-dist2line
dynpt
(if (not tf3)
(list p2 p1)
(list p1 p2)
)
)
distx (xdrx-math-roundto distx (xdrx-getvar "distancesnap"))
disty (xdrx-math-roundto disty (xdrx-getvar "distancesnap"))
dynpt (mapcar '+
(mapcar '+ p1 (xdrx-vector-product xdir distx))
(xdrx-vector-product ydir disty)
)
)
(if (equal disty 0.0 1e-3)
(setq disty (xdrx-getvar "distancesnap"))
)
(if (equal distx 0.0 1e-3)
(setq distx (xdrx-getvar "distancesnap"))
)
(setq ret1 dynpt)
(XD::Drag:CallBackSetDynPnt dynpt) ;(princ "\ndistx=")
;(princ distx)
;(princ "\ndistyx=")
;(princ disty)
(setq h (xd::doc:getpickboxheight))
(setq pt2 (mapcar '+ p1 (xdrx-vector-product xdir distx))
pt3 dynpt
)
(xdrx-setpropertyvalue
txt1
"textstring"
(rtos (abs (distance p1 p2))
2
1
)
"position"
(setq txtp (xdrx-line-midp p1 p2))
"textheight"
h
)
(setq tbox (xdrx-getpropertyvalue txt1 "textbox")
tbox (xd::pnts:close tbox)
tbox (xdrx-points-offset (/ h 3.0) tbox)
pmid (xd::geom:get9pt tbox 2)
v (xdrx-vector-normalize (mapcar '- (cadr tbox) (car tbox)))
)
(xdrx-entity-align
txt1
(if (xdrx-vector-iscodirectional v xdir (/ pi 4))
pmid
(xd::geom:get9pt tbox 2)
)
v
(mapcar '+
(xdrx-line-midp p1 p2)
(xdrx-vector-product ydir (/ h 3.0))
)
(if (xdrx-vector-iscodirectional v xdir (/ pi 4))
xdir
ydir
)
)
(xd::text:adjust txt1)
(setq tbox (xdrx-getpropertyvalue txt1 "textbox")
tbox (xd::pnts:close tbox)
tbox (xdrx-points-offset (/ h 3.0) tbox)
tbox (xd::pnts:close tbox)
)
(xdrx-grdraw 8 -1 tbox)
(xdrx-grdraw 2 1 txt1)
(xdrx-setpropertyvalue
txt2
"textstring"
(rtos (abs disty) 2 1)
"position"
(setq txtp (xdrx-line-midp
(setq pt-3 (xdrx-points-orthoproject
dynpt
(list p2 (mapcar '+ p2 ydir))
)
)
p2
)
)
"textheight"
h
)
(setq tbox (xdrx-getpropertyvalue txt2 "textbox")
tbox (xd::pnts:close tbox)
tbox (xdrx-points-offset (/ h 3.0) tbox)
pmid (xd::geom:get9pt tbox 4)
v (xdrx-vector-normalize (mapcar '- (cadr tbox) (car tbox)))
)
(xdrx-entity-align
txt2
(if (xdrx-vector-iscodirectional v xdir (/ pi 4))
pmid
(xd::geom:get9pt tbox 4)
)
v
(mapcar
'+
(xdrx-line-midp p2 pt-3)
(xdrx-vector-product (xdrx-vector-normalize xdir) (/ h 3.0))
)
(if (xdrx-vector-iscodirectional v xdir (/ pi 4))
xdir
ydir
)
)
(xd::text:adjust txt2)
(setq tbox (xdrx-getpropertyvalue txt2 "textbox")
tbox (xd::pnts:close tbox)
tbox (xdrx-points-offset (/ h 3.0) tbox)
tbox (xd::pnts:close tbox)
)
(xdrx-grdraw 8 -1 tbox)
(xdrx-grdraw 2 1 txt2)
(xdrx_setpropertyvalue
(entlast)
"constantwidth"
#xd-var-global-line-width
"color"
#xd-var-global-ent-color
)
)
(defun _prompt1 ()
(xdrx_prompt
(xdrx-string-multilanguage
"\n当前设置：线宽("
"\nCurrent setting: line width("
)
#xd-var-global-line-width
(xdrx-string-multilanguage
") 颜色(" ") Color(")
#xd-var-global-ent-color
(xdrx-string-multilanguage ") 步长(" ") StepSize(")
(xdrx-getvar "distancesnap")
")\n"
)
)
(defun _kword (kword)
(redraw)
(cond ((= kword "W")
(if (setq w (getreal (xdrx_prompt
(xdrx-string-multilanguage "\n输入线宽度<" "\nInput Constant Width<")
#xd-var-global-line-width
">:"
t
)
)
)
(progn (xd::var:setdouble "#xd-var-global-line-width" w)
(xdrx_setpropertyvalue
(entlast)
"constantwidth"
#xd-var-global-line-width
"color"
#xd-var-global-ent-color
)
)
)
)
((= kword "C")
(if (setq w (getint (xdrx_prompt
(xdrx-string-multilanguage
"\n输入颜色号<" "\nInput Color Index<")
#xd-var-global-ent-color
">:"
t
)
)
)
(progn (xd::var:setint "#xd-var-global-ent-color" w)
(xdrx_setpropertyvalue
(entlast)
"constantwidth"
#xd-var-global-line-width
"color"
#xd-var-global-ent-color
)
)
)
)
;;; (t
;;; (if (> i 0)
;;; (progn (xd::doc:command (list ".undo" 2))
;;; (setq i (1- i))
;;; (if (= i 0)
;;; (xdrx_prompt "\n所有回退已经完成.")
;;; )
;;; )
;;; (xdrx_prompt "\n所有回退已经完成.")
;;; )
;;; )
)
t
)
(defun _prompt ()
(xdrx_prompt
(xdrx-string-format
(xdrx-string-multilanguage "\n当前设置：线宽(%.1f) | 颜色(%d)" "\nCurrent Setting：LineWidth(%.1f) | Color(%d)")
#xd-var-global-line-width
#xd-var-global-ent-color
)
)
t
)
(xdrx_begin)
(xd::var:getint "#xd-var-global-ent-color" 7)
(xd::var:getdouble "#xd-var-global-line-width" 1.0)
(setq i 0
tf t
)
(while
(and
tf
(or
(and
(_prompt)
(xdrx_initget "X W C")
(setq e (xdrx_entsel
(xdrx-string-multilanguage
"\n拾取底边[线宽(W)/颜色(C)/退出(X)]<选点>:""\nPick the bottom edge [Line width (W)/Color (C)/Exit (X)]<Select point>:")
'((0 . "LINE,*POLYLINE"))
)
)
(cond
((= e "X") (setq tf nil) t)
((= (type e) 'STR) (_kword e))
(t
(if
(or
(and (xdrx_object_iskindof (car e) "*POLYLINE")
(setq seg (xdrx_polyline_onsegat (car e) (cadr e)))
(setq pts (xdrx_polyline_getlinesegat (car e) seg))
(setq #xd-var-global-line-width
(xdrx_getpropertyvalue
(car e)
"constantwidth"
)
)
(xd::var:setdouble "#xd-var-global-line-width" #xd-var-global-line-width)
)
(and (xdrx_object_iskindof (car e) "LINE")
(setq pts (xdrx-getpropertyvalue (car e) "get"))
(xd::var:getdouble "#xd-var-global-line-width" 0.0)
)
)
(setq p1 (car pts)
p2 (cadr pts)
)
(xdrx_prompt
(xdrx-string-multilanguage
"\n没有选中直线边,重试."
"\nNo straight edge selected, try again."
)
)
)
)
)
)
(progn (xdrx_sysvar_push '("osmode" 545))
(xdrx_initget
(strcat "W C"
(if (> i 1000)
" U"
""
)
)
)
(_prompt)
(setq p1 (getpoint (strcat (xdrx-string-multilanguage
"\n矩形第一点[线宽(W)/颜色(C)"
"\nFirst point of rectangle [line width (W)/color (C)"
)
(if (> i 100)
(xdrx-string-multilanguage "/回退(U)" "/Undo(U)")
""
)
(xdrx-string-multilanguage "]<退出>:" "]<Exit>:")
)
)
)
)
)
)
(progn
(cond ((= (type p1) 'STR) (_kword p1))
((and p1 p2) t)
((= (type p1) 'LIST)
(setq p2
(getpoint
p1
(xdrx-string-multilanguage
"\n矩形底边第二点(输入距离)<退出>:"
"\nSecond point of the bottom of the rectangle (input distance)<Exit>:"
)
)
)
)
)
(if (and p1 p2)
(progn (setq tf2 t)
(xdrx-sysvar-push '("osmode" 545 "dimzin" 0))
(while (and tf2
(XD::Drag:CallBackSetMouseMove "_callback")
(XD::Drag:CallbackSetKeyword "_keyword")
(setq txt1 (xdrx-text-make)
txt2 (xdrx-text-make)
)
(xd::doc:setkeyword "C W A S D F G")
(setq lxd p1
dxy p2
)
(_prompt1)
(setq pts
(XD::DRAG:RECTANG
(xdrx-string-multilanguage
"\n矩形顶边右上点[颜色(C)/线宽(W)/步长0(A)/步长1(S)/步长5(D)/步长10(F)/设置(G)](输入距离)<退出>"
"\nPoint on the top right of the rectangle or[Color(C)/LineWidth(W)/Step0(A)/Step1(S)/Step5(D)/Step10(F)/Settings(G)](Input distance)<Exit>"
)
(list p1 p2)
)
)
)
(progn (redraw)
(vla-startundomark *XD:Doc*)
(setq i (1+ i))
(xdrx_setpropertyvalue
(entlast)
"constantwidth"
#xd-var-global-line-width
"color"
#xd-var-global-ent-color
)
(vla-endundomark *XD:Doc*)
(setq tf2 nil)
(xdrx-free txt1 txt2)
)
)
)
)
(setq p1 nil
p2 nil
)
)
(redraw)
(xdrx_sysvar_pop)
)
(xdrx_end)
(princ)
)
