Author Topic: [XDrX-PlugIn(146)] Make Hatch along path  (Read 112 times)

0 Members and 1 Guest are viewing this topic.

xdcad

  • Bull Frog
  • Posts: 495
[XDrX-PlugIn(146)] Make Hatch along path
« on: April 17, 2024, 08:03:37 AM »

Code: [Select]
(defun c:xdtb_hapath (/ ang box clr ha ha1 pat remove scl ss tm x)
  (xd::doc:getdouble (xdrx-string-multilanguage "\n上方距离" "\nDistance above") "#xd-var-global-up-dist"
     10.0
  )
  (xd::doc:getdouble (xdrx-string-multilanguage "\n下方距离" "\nDistance below") "#xd-var-global-down-dist"
     10.0
  )
  (if (setq ha (xd::odcl:hatchdlg1 "" "" 1))
    (progn
      (setq pat (cadr (assoc "Pattern" ha))
    remove (cadr (assoc "RemoveBoundary" ha))
    scl (cadr (assoc "Scale" ha))
    clr (cadr (assoc "Color" ha))
    ang (xdrx_math_degtor (atof (cadr (assoc "Angle" ha))))
    tm (atoi (cadr (assoc "Transparency" ha)))
      )
      (if (setq ss (xdrx-ssget (xdrx-string-multilanguage "\n拾取路径多段线<退出>:"
  "\nPick Path Polyline<Exit>:"
       ) '((0 . "*polyline") (-4 . "&=")
(70 . 0)
       )
   )
  )
(progn
  (xdrx-begin)
  (xdrx-sysvar-push '("BoxFillet" 1))
  (mapcar
    '(lambda (x)
       (setq box (xdrx-getpropertyvalue x "tobox" #xd-var-global-down-dist #xd-var-global-up-dist 0.0
0.0
)
       )
       (setq ha1 (xdrx-hatch-make (xdrx-polyline-make box t)))
       (xdrx-setpropertyvalue ha1 "PatternName" pat "PatternScale" scl "PatternAngle" ang "color" clr
      "Transparency" tm
       )
       (if (= 1 remove)
(progn
   (xdrx-entity-delete (xdrx-getpropertyvalue ha1 "assocobjids"))
)
       )
     )
    (xdrx-ss->ents ss)
  )
  (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.
===================================
https://github.com/xdcad
https://sourceforge.net/projects/xdrx-api-zip/
http://bbs.xdcad.net