这个代码很好，我喜欢
这段代码很好，我喜欢，但需要一点修改。非常感谢你，塔瓦，你能给我接电话吗
我不需要选择4个点来填充，只需要选择一个点，（选择内部点）就像内部命令：bhatch一样，我也只需要ANSI131和ANSI137。
(defun c:Test (/ *error* dlg p a i l 1p sc e pl h gr rot r)
;; Author : Tharwat Al Shoufi 14. Apr. 2014 ;;
(defun *error* (msg)
(if (< id 0)
(unload_dialog id)
)
(if (and d (setq d (findfile d)))
(vl-file-delete d)
)
(if (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")
(princ msg)
(princ (strcat "\nError: " msg))
)
(princ)
)
;; ;;
(defun dlg (h / d o id head tail go back)
(if (and (setq d (vl-filename-mktemp nil nil ".dcl")) (setq o (open d "w")))
(progn (setq head "test : dialog { label = \"Hatch Control\";"
tail ": button { label = \"Exit\"; key = \"esc\"; width = 12; height = 2; fixed_width = true; alignment = centered;
is_default = true; is_cancel = true;}"
)
(if h
(write-line
(strcat
head ": button { label = \"ANSI37\"; key = \"i37\"; width = 10; height = 2.5;} spacer; "
": button { label = \"ANSI31\"; key = \"i31\"; width = 10; height = 2.5;} spacer; " tail "}"
)
o
)
(write-line
(strcat
head ": boxed_column { label = \"Controls\"; : text { label = \"Scale\";}"
": row { : button { label = \"+\"; key = \"isc\"; width = 2;}"
": button { label = \"-\"; key = \"dsc\"; width = 2;}}" "spacer; : text { label = \"Rotation\";}"
": row { : button { label = \"+\"; key = \"iro\"; width = 2;}"
": button { label = \"-\"; key = \"dro\"; width = 2;}}} spacer;" tail "}"
)
o
)
)
(close o)
)
)
(if (or (not d)
(> 0 (setq id (load_dialog d)))
(not (new_dialog
"test"
id
""
(if *loc*
*loc*
'(-1 -1)
)
)
)
)
(progn (if (< id 0)
(unload_dialog id)
)
(if (and d (setq d (findfile d)))
(vl-file-delete d)
)
)
(progn
(action_tile "i37" "(setq go \"ANSI37\") (done_dialog)")
(action_tile "i31" "(setq go \"ANSI31\") (done_dialog)")
(if (eq *pat* "ANSI37")
(mapcar '(lambda (u) (mode_tile u 1)) (list "iro" "dro"))
)
(action_tile
"iro"
"(if (>= (setq rot (+ rot (/ pi 12.))) (+ pi pi))
(setq rot (/ pi 12.)) rot)(setq r t *loc* (done_dialog))"
)
(action_tile
"dro"
"(if (>= (setq rot (- rot (/ pi 12.))) (+ pi pi))
(setq rot (/ pi 12.)) rot)(setq r t *loc* (done_dialog))"
)
(action_tile "isc" "(setq sc (+ sc 0.5) back t *loc* (done_dialog))")
(action_tile
"dsc"
"(if (<= (setq sc (- sc 0.5)) 0.)(setq sc 0.5) sc)(setq back t *loc* (done_dialog))"
)
(action_tile "esc" "(setq back nil r nil)(done_dialog)")
(start_dialog)
(unload_dialog id)
(vl-file-delete d)
)
)
(cond ((and back) (vla-put-patternscale v sc) (vla-update v) (dlg nil))
((and r) (vla-put-PatternAngle v rot) (vla-update v) (dlg nil))
(t nil)
)
go
)
;; ;;
(if (eq 4 (logand 4 (cdr (assoc 70 (entget (tblobjname "LAYER" (getvar 'CLAYER)))))))
(alert "Current layer is LOCKED ! Unlock and Try again .")
(if (and (setq *pat* (dlg t)) (setq p (getpoint "\n Specify point < 1 > :")))
(progn (setq v nil
a p
i 1
sc1.0
rot 0.
l (cons p l)
)
(while (/= (length l) 4)
(setq 1p (getpoint p (strcat "\n Next point < " (itoa (setq i (1+ i))) " > :")))
(setq l (cons 1p l)
p 1p
)
)
(setq e (entmakex
(append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(70 . 1) '(90 . 4))
(mapcar '(lambda (u) (cons 10 u)) (cons a l))
)
)
)
(setq pl (entlast))
(command "_.-hatch" "S" e "" "P" *pat* 1.0 0.0 "")
(setq h (entlast))
(vla-put-AssociativeHatch (setq v (vlax-ename->vla-object h)) :vlax-false)
(entdel e)
(if (not (eq pl h))
(dlg nil)
)
)
)
)
(princ)
)
(vl-load-com) 听起来像是可以用宏处理的东西。
我个人更喜欢一个简单的插件，但每个插件都是自己的。
我同意，只需从工具选项板中进行简单的拖放，您就完成了。 修改它会很困难吗 （定义c：测试（/*错误*cm id d dlg p sc h ht gr rot r）；；作者：Tharwat Al-Shoufi 14。2014年4月；；（defun*error*（msg）（if（<id 0）（unload_dialog id））（if（and d（setq d（findfile d）））（vl file delete d））（if cm（setvar'CMDECHO cm））（if（wcmatch（strcase msg）“*BREAK*，*CANCEL*，*EXIT*”（princ msg）（princ（strcat“\error：”msg）））（princ））；；（defun dlg（h/o head-tail-back）（if（and（setq d（vl filename mktemp nil nil.dcl））（setq o（open d“w”）））（progn（setq head“test:对话框{label=\”Hatch Control\“；”尾部“：按钮{label=\“Exit\”；键=\“esc\”；宽度=12；高度=2；固定宽度=true；对齐=居中；is\u default=true；is\u cancel=true；}”）（如果h（写线（strcat头）：按钮{label=\“ANSI37\”键=\“i37\”，宽度=10；高度=2.5；}垫片；“”：按钮{label=\“ANSI31\”键=\“i31\”宽度=10；高度=2.5；}垫片；“tail”}）o）（写入行（strcat head）：装箱列{label=\“Controls\”；：文本{label=\“Scale\”；}“”：行{：按钮{label=\“+\”键=\“isc\”宽度=2；}“”：按钮{label=\“-\”键=\“dsc\”宽度=2；}}}“”垫片；：文本{label=\“Rotation\”；}“”：行{：按钮{label=\“+\”键=\“iro\”宽度=2；}“”：按钮{label=\“-\”键=\“dro\”宽度=2；}}}}垫片；“tail”}“）o））（close o））（if（or（not d）（>0（setq id（load\u dialog d））（not（new\u dialog“test”id”“（if*loc**loc*'（-1-1）））（progn（if（<id 0）（unload\u dialog id））（if（and d（setq d（findfile d）））（vl file delete d））（progn（action\u tile“i37”“（setq go“ANSI37”“）（done\u dialog）”）（action\u tile“i31”“（setq go“ANSI31”“）（done\u dialog）”（if（eq*pat*“ANSI37”）（mapcar（lambda（u）（mode\u tile u 1））（list“iro”“dro”））（action_tile“iro”“（if（>=（setq rot（+rot（/pi 12）））（+pi-pi））（设置旋转（/pi 12）rot）（setq r t*loc*（done\u dialog）））（action\u tile“dro”“（if（>=（setq rot（-rot（/pi 12）））（+pi-pi））（设置旋转（/pi 12）rot）（setq r t*loc*（done\u dialog））“”（action\u tile“isc”“（setq sc（+sc 0.5）back t*loc*（done\u dialog））“”（action\u tile“dsc”“（如果（ 不，不会，但有时打桩机压得过重时，锤子也可以。
换句话说，lisp并不是每个问题的答案，尽管许多用户认为它是。
不客气，谢谢你的好话。
..........
页:
[1]