Author Topic: [XDrX-PlugIn(60)] Draw rectangle with edges  (Read 568 times)

0 Members and 1 Guest are viewing this topic.

xdcad

  • Bull Frog
  • Posts: 479
[XDrX-PlugIn(60)] Draw rectangle with edges
« on: December 24, 2023, 10:30:48 PM »
1. edges
2. two point

Code: [Select]
(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)
)
The code I wrote uses XDRX-API,which can be downloaded from github.com and is updated at any time.
===================================
[XDrx-Sub Forum]
https://www.theswamp.org/index.php?board=78.0
https://github.com/xdcad/XDrx-API
http://bbs.xdcad.net