自定义CAD的图案填充
highflybird
- 登录 发表评论
;|*************************************************************;
软件作者: Highflybird ;
软件用途: 用于制作AutoCAD的自定义填充图案 ;
日期地点: 2025.8.15 深圳 ;
程序语言: AutoLISP,Visual LISP ;
版本号: Ver. 1.0.25.0815 ;
===============================================================;
================================================================
本软件为开源软件: 以下是开源申明:
----------------------------------------------------------------
本页面的软件遵照 GPL协议开放源代码，您可以自由传播和修改，在遵照
下面的约束条件的前提下:
一. 只要你在本开源软件的每一副本上明显和恰当地出版版权声明，保持
此许可证的声明和没有担保的声明完整无损，并和程序一起给每个其
他的程序接受者一份许可证的副本，你就可用任何媒体复制和发布你
收到的原始程序的源代码。你也可以为转让副本的实际行动收取一定
费用，但必须事先得到的同意。
二. 你可以修改本开源软件的一个或几个副本或程序的任何部分，以此形
成基于程序的作品。只要你同时满足下面的所有条件，你就可以按前
面第一款的要求复制和发布这一经过修改的程序或作品。
1.你必须在修改的文件中附有明确说明：你修改了这一文件及具体的修
改日期。
2.你必须使你发布或出版的作品（它包含程序的全部或一部分，或包含
由程序的全部或部分衍生的作品）允许第三方作为整体按许可证条款
免费使用。
3.如果修改的程序在运行时以交互方式读取命令，你必须使它在开始进
入常规的交互使用方式时打印或显示声明: 包括适当的版权声明和没
有担保的声明（或者你提供担保的声明）；用户可以按此许可证条款
重新发布程序的说明；并告诉用户如何看到这一许可证的副本。（例
外的情况: 如果原始程序以交互方式工作，它并不打印这样的声明，
你的基于程序的作品也就不用打印声明。
三. 只要你遵循一、二条款规定，您就可以自由使用并传播本源代码，但
必须原封不动地保留原作者信息。
================================================================
**************************************************************|;
(defun c:mp (/ DAT ENT EPS FILE H LST N OLDZIN PATH PT0 PT1 PT2 PTS SEL STR W BOX ENTS H0 MINPT W0 bStaggered w1 h1 name title)
(setq sel (ssget '((0 . "LINE,*POLYLINE,SPLINE,CIRCLE,ARC,ELLIPSE,POINT"))))
(if sel
(progn
(setq ents (PAT:sel->List sel))
(setq box (PAT:GetBox ents))
(setq w0 (mapcar '- (cadr box) (car box)))
(setq h0 (cadr w0))
(setq w0 (car w0))
(setq minPt (car box))
(setq pt0 (PAT:getPoint minPt w0 h0))
(setq name (cadddr pt0))
(setq bStaggered (last pt0))
(setq w1 (cadr pt0))
(setq h1 (caddr pt0))
(if bStaggered
(setq w w1 h (+ h1 h1))
(setq w w1 h h1)
)
(setq pt0 (car pt0))
(setq n 4)
(setq eps (expt 0.1 n))
(setq lst nil)
(foreach ent ents
(setq pts (PAT:getSegments ent 32))
(foreach p pts
(setq pt1 (car p))
(setq pt2 (cadr p))
(if (equal pt1 pt2)
(setq pt2 (mapcar '- pt1 pt0)
dat (list 0 (car pt2) (cadr pt2) 0 h 0 (- w))
)
(setq dat (PAT:getLineCluster pt0 pt1 pt2 w h eps))
)
(if bStaggered
(setq lst (PAT:GetStaggeredLines dat w1 h1 lst))
(setq lst (cons dat lst))
)
)
)
(setq oldzin (getvar "dimzin"))
(setvar "dimzin" 12)
(setq path (getvar "DWGPREFIX"))
(setq path (strcat path name ".pat"))
(setq file (open path "w"))
(setq title (strcat "*" name ", Made by Highflybird"))
(write-line title file)
(foreach e lst
(setq str (PAT:GetRightString e 7))
(write-line str file)
)
(close file)
(setvar "dimzin" oldzin)
)
)
(princ)
)
;;;-------------------------------------------------------------
;;; 设置参数
;;;-------------------------------------------------------------
(defun PAT:getPoint (minPt w0 h0 / w h cp p name BYBOX DCLDATA PT0 space x y)
(setq DCLData (getenv "PatternMaker")) ;读取以前配置
(if (null DCLData)
(setq dclData (PAT:SetDefault))
(setq DCLData (read DCLData))
)
(setq space (atof (PAT:GetKeyData "space")))
(setq x (atof (pat:getkeydata "baseX")))
(setq y (atof (pat:getkeydata "baseY")))
(if (setq byBox (= "1" (cdr (assoc "bybox" DCLData))))
(setq w (+ w0 space space)
h (+ h0 space space)
p (mapcar '- minPt (list (- space) (- space)))
)
(setq w (atof (cdr (assoc "width" DCLData)))
H (atof (cdr (assoc "height" DCLData)))
p (list x y 0)
)
)
(setq name (cdr (assoc "name" DCLData)))
(if (or (not name) (= name ""))
(progn
(princ "\n图案名为空字符!新的图案名将为默认的\"pattern1\"")
(setq name "pattern1")
(PAT:SetKeyData "name" "pattern1")
)
)
(setq cp (/= "normal" (cdr (assoc "layout" DCLData))))
(initget 8 "Set _ Set")
(setq pt0 (getpoint "\n选取基点[设置(Set)]："))
(if (= pt0 "Set")
(progn
(setq dclData (c:pat))
(if (null dclData)
(progn
(princ "\n你取消了设置, 现在将按照先前设置.")
(setq DCLData (read (getenv "PatternMaker")))
)
)
(setq space (atof (PAT:GetKeyData "space")))
(setq x (atof (pat:getkeydata "baseX")))
(setq y (atof (pat:getkeydata "baseY")))
(if (setq byBox (= "1" (cdr (assoc "bybox" DCLData))))
(setq w (+ w0 space space)
h (+ h0 space space)
p (mapcar '- minPt (list (- space) (- space)))
)
(setq w (atof (PAT:GetKeyData "width"))
H (atof (PAT:GetKeyData "height"))
p (list (atof (PAT:GetKeyData "baseX"))(atof (PAT:GetKeyData "baseY")))
)
)
(setq cp (/= "normal" (PAT:GetKeyData "layout")))
(setq name (PAT:GetKeyData "name"))
(list p w h name cp)
)
(if (null pt0)
(list p w h name cp)
(progn
(if (or (not name) (= name ""))
(progn
(setq name (getstring "\n请输入图案名字:"))
(if (= name "")
(progn
(princ "\n你输入了空字符!新的图案名将为默认的\"pattern1\"")
(setq name "pattern1")
)
)
(PAT:SetKeyData "name" name)
)
)
(list (trans pt0 1 0) w h name cp)
)
)
)
)
;;;-------------------------------------------------------------
;;; 功能: 根据基点和两点以及排布的间距来确定填充线条簇
;;; 输入: 基点p0 ,线段的两端点p1,p2以及横向和纵向间距
;;; 输出: 这个线簇的填充表达
;;;-------------------------------------------------------------
(defun PAT:getLineCluster (p0 p1 p2 w h eps / AN CX D1 D2 D3 D4 DD DL DV DX DY f1 f2 K P3 PX PY RS SX VX VY)
(setq w (float w))
(setq h (float h))
(setq an (angle p1 p2))
(if (>= an Pi) ;如果角度大于180，则交换线段的两点
(setq p3 p1 p1 p2 p2 p3)
)
(setq dv (mapcar '- p2 p1))
(setq vx (car dv))
(setq vy (cadr dv))
(setq dx (abs vx))
(setq dy (abs vy))
(setq p0 (mapcar '- p1 p0))
(setq px (car p0))
(setq py (cadr p0))
(cond
( (equal dy 0 eps);如果是水平的线段
(setq an 0)
(if (< vx 0)
(setq px (+ vx px))
)
(if (< dx w)
(list an px py 0 h dx (- dx w))
(list an px py 0 h)
)
)
( (equal dx 0 eps);如果是垂直的线段
(setq an 90)
(if (< vy 0)
(setq py (+ vy py))
)
(if (< dy h)
(list an px py 0 w dy (- dy h))
(list an px py 0 w)
)
)
(t
(setq k (/ (* h dx) (* w dy)))
(if (> k 1)
(setq rs (mapcar 'reverse (findSimplestFraction (/ 1.0 k) eps)))
(setq rs (findSimplestFraction k eps))
)
(setq f1 (car rs)) ;最简分数表达
(setq d1 (* (car f1) w))
(setq d2 (* (cadr f1) h))
(setq dd (PAT:hypot d1 d2))
(setq dl (PAT:hypot dx dy))
(setq an (atan (PAT:sign vy d2) (PAT:sign vx d1)));(setq an (atan vy vx))
(cond
( (setq f2 (cadr rs)) ;第二最简分数表达
(setq d3 (* (car f2) w))
(setq d4 (* (cadr f2) h))
(setq p3 (trans (list d3 d4) 0 (list d1 d2)))
(setq cx (last p3))
(setq sx (car p3))
(if (< (* vy vx) 0)
(setq sx (- sx))
)
)
( (= (cadr f1) 1) ;如果没有第二最简分数表达，则求出最近距离，当分母为1的时候
(setq cx (* w (cos an)))
(setq sx (* w (sin (- an))))
)
( (= (car f1) 1) ;分子为1的时候
(setq cx (* h (sin an)))
(setq sx (* h (cos an)))
)
(t
(setq k (fix k))
(setq cx (* w (cos an)))
(setq sx (* w (sin (- an))))
(setq dd (PAT:hypot (* k w) h))
)
)
(setq an (PAT:Rad2Deg an)) ;换算成角度
(if (< dl dd)
(list an px py cx sx dl (- dl dd)) ;则为虚线
(list an px py cx sx) ;则实线
)
)
)
)
;;;-------------------------------------------------------------
;;; 交错排布的图案
;;;-------------------------------------------------------------
(defun PAT:GetStaggeredLines (dat w1 h1 lst / ang ptx pty ddd xxx)
(setq lst (cons dat lst))
(setq ang (car dat))
(setq ptx (cadr dat))
(setq pty (caddr dat))
(setq ddd (cdddr dat))
(setq ptx (+ (* 0.5 w1) ptx))
(setq pty (+ h1 pty))
(setq xxx (append (list ang ptx pty) ddd))
(setq lst (cons xxx lst))
)
;;;-------------------------------------------------------------
;;; 根据一个数的正负号返回改变另外一个数的正负
;;;-------------------------------------------------------------
(defun PAT:sign (x y)
(if (>= x 0) y (- y))
)
;;;-------------------------------------------------------------
;;; 弧度转角度
;;;-------------------------------------------------------------
(defun PAT:Rad2Deg (x)
(setq x (* 57.295779513082320876798154814105 x))
(if (< x 0)
(+ x 360)
x
)
)
;;;-------------------------------------------------------------
;;; 角度转弧度
;;;-------------------------------------------------------------
(defun PAT:Deg2Rad (x)
(* 0.01745329251994329576923690768489 x)
)
;;;-------------------------------------------------------------
;;; 欧几里德范数
;;;-------------------------------------------------------------
(defun PAT:hypot(x y)
(sqrt (+ (* x x) (* y y)))
)
;;;-------------------------------------------------------------
;;; 在指定误差内寻找一个实数的最简分数
;;;-------------------------------------------------------------
(defun findSimplestFraction (x tol / A0 AI AX EPS error I RM hCurr kCurr hPrev kPrev hPrev0 kPrev0 lst)
(setq eps 1e-15)
(setq x (abs x))
(setq a0 (fix x))
(setq rm (- x a0))
(setq error (abs rm))
(if (or (< error tol) (< error eps))
(list (list a0 1))
(progn
(setq hPrev0 1)
(setq hPrev a0)
(setq kPrev0 0)
(setq kPrev 1)
(setq i 0)
(while (and (< i 50) (> error tol))
(setq ax (/ 1.0 rm))
(setq ai (fix ax))
(setq rm (- ax ai))
(setq hCurr (+ (* ai hPrev) hPrev0))
(setq kCurr (+ (* ai kPrev) kPrev0))
(setq lst (cons (list hCurr kCurr) lst))
(setq error (abs (- x (/ (float hCurr) kCurr))))
(if (> error tol)
(setq hPrev0 hPrev
hPrev hCurr
kPrev0 kPrev
kPrev kCurr
i (1+ i)
)
)
)
lst
)
)
)
;;;-------------------------------------------------------------
;;; mac-lee的寻找最简分数
;;;-------------------------------------------------------------
(defun findSimplestFractionLM (num tol / a r)
(defun recurse (x p q pp qq / a d n r)
(setq a (fix (+ 1e-12 x))
r (- x a)
n (+ (* a p) pp)
d (+ (* a q) qq)
)
(if (or (< (abs (- num (/ n (float d)))) tol)
(< (abs r) tol)
)
(list n d)
(recurse (/ 1.0 r) n d p q)
)
)
(setq a (fix (+ 1e-12 num))
r (- num a)
)
(if (and (< 0 a) (< (abs r) tol))
(list a 1)
(recurse (/ 1.0 r) a 1 1 0)
)
)
;;;-------------------------------------------------------------
;;; 耗时计算
;;; 例如：(setq t0 (getvar "TDUSRTIMER")) ->计时开始
;;; 运行某段程序后用 (printtime t0 "程序") ->计时结束
;;;-------------------------------------------------------------
(defun printtime (t0 str)
(princ (strcat str "费时: "))
(princ (* (- (getvar "TDUSRTIMER") t0) 86400))
(princ "秒.\n")
)
;;;-------------------------------------------------------------
;;; 选择集包围盒
;;;-------------------------------------------------------------
(defun PAT:GetBox (ents / pta ptb pts obj)
(foreach ent ents
(setq obj (vlax-ename->vla-object ent))
(vla-getboundingbox obj 'pta 'ptb)
(setq pta (vlax-safearray->list pta))
(setq ptb (vlax-safearray->list ptb))
(setq pts (cons pta pts))
(setq pts (cons ptb pts))
)
(list
(apply 'mapcar (cons 'min pts))
(apply 'mapcar (cons 'max pts))
)
)
;;;-------------------------------------------------------------
;;; 选择集转为图元列表
;;;-------------------------------------------------------------
(defun PAT:sel->List (sel / lst ent)
(if sel
(while (setq ent (ssname sel 0))
(setq lst (cons ent lst))
(ssdel ent sel)
)
)
(reverse lst)
)
;;;-------------------------------------------------------------
;;; 由于图案填充每行不多于80个字符，故需要递归计算
;;;-------------------------------------------------------------
(defun PAT:GetRightString (e n / str)
(setq str "")
(foreach v e
(setq str (strcat str (rtos v 2 n) ","))
)
(setq str (substr str 1 (1- (strlen str))))
(if (<= (strlen str) 80)
str
(PAT:GetRightString e (1- n))
)
)
;;;-------------------------------------------------------------
;;; 获取线段
;;;-------------------------------------------------------------
(defun PAT:getSegments (ent n / DXF P1 P2 PTS TYP)
(setq dxf (entget ent))
(setq typ (cdr (assoc 0 dxf)))
(if (= typ "POINT")
(setq p1 (cdr (assoc 10 dxf))
pts (list (list p1 p1))
)
(progn
(cond
( (= typ "LINE")
(setq p1 (cdr (assoc 10 dxf)))
(setq p2 (cdr (assoc 11 dxf)))
(setq pts (list p1 p2))
)
( (= typ "POLYLINE")
(setq pts (get-3dpolyline-vertexs ent))
)
( (= typ "LWPOLYLINE")
(setq pts (get-pline-vertexs ent n))
)
( (= typ "SPLINE")
(setq pts (get-spline-vertexs ent 8))
)
(t (setq pts (get-curve-vertexs ent n)))
)
(if (vlax-curve-isClosed ent)
(mapcar 'list pts (cdr (append pts (list (car pts)))))
(mapcar 'list pts (cdr pts))
)
)
)
)
;;;-------------------------------------------------------------
;;; 取无拟合的POLYLINE(2d或3d)顶点
;;;-------------------------------------------------------------
(defun get-3dpolyline-vertexs (poly / n i p l)
(setq n (fix (vlax-curve-getendparam poly)))
(setq i 0.0)
(repeat n
(setq p (vlax-curve-getpointatparam poly i))
(setq l (cons p l))
(setq i (1+ i))
)
(reverse l)
)
;;;-------------------------------------------------------------
;;; 取得轻多段线的点
;;;-------------------------------------------------------------
(defun get-pline-vertexs (ent n / BLG DIST ENDPAR I L1 L2 L3 LI OBJ PT PTS VEXNUM)
(setq obj (vlax-ename->vla-object ent))
(setq endpar (vlax-curve-getEndParam ent))
(setq vexNum (fix endPar))
(setq pts nil)
(setq i 0)
(repeat vexNum
(setq pt (vlax-curve-getPointAtParam ent i))
(setq pts (cons pt pts))
(setq blg (vla-getbulge obj i))
(if (/= blg 0.0)
(progn
(setq l1 (vlax-curve-getDistAtParam ent i))
(setq l2 (vlax-curve-getDistAtParam ent (1+ i)))
(setq l3 (- l2 l1))
(setq li (/ l3 n))
(setq dist l1)
(repeat (1- n)
(setq dist (+ dist li))
(setq pt (vlax-curve-getPointAtDist ent dist))
(setq pts (cons pt pts))
)
)
)
(setq i (1+ i))
)
(if (not (vlax-curve-isClosed ent))
(setq pt (vlax-curve-getEndPoint ent)
pts (cons pt pts)
)
)
pts
)
;;;-------------------------------------------------------------
;;; 取得一般曲线的点
;;;-------------------------------------------------------------
(defun get-curve-vertexs (ent n / par len seg dist pt pts)
(setq par (vlax-curve-getEndParam ent))
(setq len (vlax-curve-getDistAtParam ent par))
(setq seg (/ len n))
(setq dist 0)
(repeat n
(setq pt (vlax-curve-getPointAtDist ent dist))
(setq pts (cons pt pts))
(setq dist (+ seg dist))
)
(if (not (vlax-curve-isClosed ent))
(setq pt (vlax-curve-getEndPoint ent)
pts (cons pt pts)
)
)
(reverse pts)
)
;;;-------------------------------------------------------------
;;; 取得样条曲线的点
;;;-------------------------------------------------------------
(defun get-spline-vertexs (ent n / obj)
(setq obj (vlax-ename->vla-object ent))
(setq n (* n (vla-get-NumberOfControlPoints obj)))
(get-curve-vertexs ent n)
)
;;;-------------------------------------------------------------
;;; 对话框
;;;-------------------------------------------------------------
(defun C:PAT (/ lst dcl_id DlgRet Dcl_File BASEANG BASEPT strX strY width height)
(setq dcl_file (PAT:Write_Dcl))
(setq dcl_id (load_dialog dcl_file)) ;装入对话框文件(因为是动态，所以不必检查dcl_file
(vl-file-delete Dcl_File)
;;开始对话框操作
(setq DlgRet 2)
(while (> DlgRet 1) ;如果没有离开对话框
(new_dialog "PatternMaker" dcl_id) ;因为是动态对话框，所以可以不检查dcl_id
(PAT:InitDialog)
(setq DlgRet (start_dialog)) ;显示对话框
(cond
( (= DlgRet 2)
(initget 9)
(setq basept (getpoint "\n选取点：")) ;指定基点
(setq strX (rtos (car basePt) 2 3))
(setq strY (rtos (cadr basePt) 2 3))
(PAT:SetKeyData "baseX" (rtos (car basePt) 2 20))
(PAT:SetKeyData "baseY" (rtos (cadr basePt) 2 20))
)
( (= DlgRet 3)
(initget 15)
(setq width (getdist "\n输入宽度：")) ;指定宽度
(PAT:SetKeyData "width" (rtos width 2 20))
)
( (= DlgRet 4)
(initget 15)
(setq height (getdist "\n输入高度：")) ;指定高度
(PAT:SetKeyData "height" (rtos height 2 20))
)
)
)
(unload_dialog dcl_id)
;;离开对话框之后的动作
(cond
( (= DlgRet 0)
(princ "\n你取消了设置.") ;返回一个取消的信息给用户
)
)
(if (not (zerop DlgRet))
(if (setq lst (getenv "PatternMaker"))
(read lst)
)
)
)
;;;-------------------------------------------------------------
;;; 对话框初始化
;;;-------------------------------------------------------------
(defun PAT:InitDialog (/ DCLData style i value)
(setq DCLData (getenv "PatternMaker")) ;读取以前配置
(if (null DCLData)
(setq dclData (PAT:SetDefault))
(setq DCLData (read DCLData))
)
(foreach n DCLData ;其他数据
(set_tile (car n) (cdr n))
)
(PAT:ActionKeys)
(setq value (atoi (cdr (assoc "bybox" DCLData ))))
(foreach key '("width" "height" "baseX" "baseY" "pickw" "pickh" "pick")
(mode_tile key value)
)
(mode_tile "space" (- 1 value))
(mode_tile "scale" 0)
(action_tile "bybox" "(PAT:ActionByBox $key $value)")
(action_tile "pick" "(done_dialog 2)")
(action_tile "pickw" "(done_dialog 3)")
(action_tile "pickh" "(done_dialog 4)")
)
;;;-------------------------------------------------------------
;;; 设置默认参数
;;;-------------------------------------------------------------
(defun PAT:SetDefault (/ default)
(setq default
'(("name" . "pattern1")
("layout" . "normal")
("width" . "10")
("height" . "10")
("scale" . "0")
("baseX" . "0")
("baseY" . "0")
("bybox" . "0")
("space" . "0")
)
)
(setenv "PatternMaker" (VL-PRIN1-TO-STRING Default))
(reverse Default)
)
;;;-------------------------------------------------------------
;;; 对话框设置默认参数
;;;-------------------------------------------------------------
(defun PAT:SetToDefault ()
(foreach n (PAT:SetDefault)
(set_tile (car n) (cdr n))
)
)
;;;-------------------------------------------------------------
;;; 控件
;;;-------------------------------------------------------------
(defun PAT:keyList ()
'("layout" "name" "width" "height" "scale" "baseX" "baseY" "bybox" "space")
)
;;;-------------------------------------------------------------
;;; 获取某个控件的值
;;;-------------------------------------------------------------
(defun PAT:GetKeyData ($key / DCLData)
(setq DCLData (read (getenv "PatternMaker")))
(cdr (assoc $key DCLData))
)
;;;-------------------------------------------------------------
;;; 更新某个控件的值
;;;-------------------------------------------------------------
(defun PAT:SetKeyData ($key $value / DCLData)
(setq DCLData (read (getenv "PatternMaker")))
(setq DCLData (subst (cons $key $value) (assoc $key DCLData) DCLData))
(setenv "PatternMaker" (VL-PRIN1-TO-STRING DCLData))
)
;;;-------------------------------------------------------------
;;; 检查参数
;;;-------------------------------------------------------------
(defun PAT:CheckData (data)
(and
(= (type data) 'list)
(equal (mapcar 'car data) (PAT:keyList))
)
)
;;;-------------------------------------------------------------
;;; 校验参数并确保其有效性
;;;-------------------------------------------------------------
(defun PAT:VerifyData (/ data)
(if (null (setq Data (getenv "PatternMaker")))
(setq data (PAT:SetDefault))
(if (PAT:CheckData (setq data (read data)))
data
(PAT:SetDefault)
)
)
)
;;;-------------------------------------------------------------
;;; 控件动作
;;;-------------------------------------------------------------
(defun PAT:ActionKeys (/ keylst)
(foreach key (PAT:keyList)
(ACTION_TILE key "(PAT:SetKeyData $key $value)")
)
)
(defun PAT:ActionByBox ($key $value / value)
(PAT:SetKeyData $key $value)
(setq value (atoi $value))
(foreach key '("width" "height" "baseX" "baseY" "pickw" "pickh" "pick")
(mode_tile key value)
)
(mode_tile "space" (- 1 value))
)
;;;-------------------------------------------------------------
;;; DCL文件
;;;-------------------------------------------------------------
(defun PAT:DCL ()
(list
"PatternMaker:dialog{
label = \"图案万花筒--设置\";
initial_focus = \"name\";
:radio_row{label = \"排布方式\";value = \"normal\";key = \"layout\";
:radio_button{label = \"直排\";key = \"normal\";}
:radio_button{label = \"错排\";key = \"straggered\";}}
:edit_box{label = \"图案名称\";key = \"name\";}
:row{:edit_box{label = \"横向间距\";key = \"width\";width =28;}:button{label = \"拾取\";key = \"pickw\";}}
:row{:edit_box{label = \"竖向间距\";key = \"height\";width =28;}:button{label = \"拾取\";key = \"pickh\";}}
:row{:column{
:edit_box{label = \"基点X值:\";key = \"baseX\";width =28;}
:edit_box{label = \"基点Y值:\";key = \"baseY\";width =28;}}
:button{label = \"拾取\";key = \"pick\";height = 4;}}
spacer;
//:popup_list{label = \"缩放比例\";key = \"scale\";list = \"1:1\\n1:10\\n1:100\\n1:1000\\n1000:1\\n100:1\\n10:1\";}
:row{:toggle{key = \"bybox\"; label = \"以包围盒计算\";}:edit_box{label = \"边距\";key = \"space\";}}
spacer;ok_cancel;}"
)
)
;;;-------------------------------------------------------------
;;; 临时生成Dcl文件 返回文件名
;;;-------------------------------------------------------------
(defun PAT:Write_Dcl (/ Dcl_File file str)
(setq Dcl_File (vl-filename-mktemp nil nil ".DCL"))
(setq file (open Dcl_File "W"))
(foreach str (PAT:DCL)
(princ str file)
)
(close file)
Dcl_File
)
(vl-load-com)
(prompt "\n制作自定义填充图案的命令：MP")
(princ)