求高手帮忙修改代码。批量修改直径改为圆心添加十字标
本帖最后由 wutao8282 于 2022-5-16 20:33 编辑(defun c:tt (/ f file tmp)
(setqf (getfiled "选择文件夹并任意选取一个文件,请先剔除无需处理文件"
"d:\\"
"dwg"
0
)
f (vl-filename-directory f)
f (mapcar '(lambda (x) (strcat f "\\" x))
(vl-directory-files f "*.dwg" 1)
)
)
(setq tmp (open (setq file (strcat (getenv "TEMP") "\\tmp.scr")) "w"))
(foreach n f
(write-line (strcat "_.open \"" n "\"") tmp)
(write-line
"(setq ss (ssget \"x\" '((0 . \"CIRCLE\") (40 . 0.5))))
(repeat(setq n (sslength ss))
(setqen (ssname ss (setq n (1- n)))
en (entget en)
en (subst (cons 40 9) (assoc 40 en) en)
)
(entmod en)
)"
tmp
)
(write-line "_.qsave _.close" tmp)
)
(close tmp)
(command ".script" file)
(vl-file-delete file)
(princ)
)论坛找的批量修改直径代码,跪求高手能帮忙改成圆心添加十字标,十字标的长度为10mm
wutao8282 发表于 2022-5-19 21:14
能帮忙改成dxf格式吗?
(defun c:tt (/ f file tmp)
(setqf (getfiled "选择文件夹并任意选取一个文件,请先剔除无需处理文件"
"C:\\Temp\\1\\"
"dxf"
0
)
f (vl-filename-directory f)
f (mapcar '(lambda (x) (strcat f "\\" x))
(vl-directory-files f "*.dxf" 1)
)
)
(setq tmp (open (setq file (strcat (getenv "TEMP") "\\tmp.scr")) "w"))
(foreach n f
(write-line (strcat "_.open " n "") tmp)
(write-line "(setq ss(ssget \"x\" '((0 . \"CIRCLE\") (40 . 0.5))))" tmp)
(write-line "(if ss(repeat(setq n(sslength ss))(setq en(ssname ss(setq n(1- n)))endate(entget en)pt(cdr(assoc 10 endate)))" tmp)
(write-line "(entmake(list(cons 0\"LINE\")(cons 10(list(-(car pt)5)(cadr pt)(caddr pt)))(cons 11(list(+(car pt)5)(cadr pt)(caddr pt)))))" tmp)
(write-line "(entmake(list(cons 0\"LINE\")(cons 10(list(car pt)(-(cadr pt)5)(caddr pt)))(cons 11(list(car pt)(+(cadr pt)5)(caddr pt)))))" tmp)
(write-line "(entdel en)))" tmp)
(write-line (strcat "_.qsave dxf 16 " n " y _.close") tmp)
)
(close tmp)
(command ".script" file)
(vl-file-delete file)
(princ)
) 本帖最后由 xiaolong1487 于 2022-5-19 19:24 编辑
(defun c:tt (/ f file tmp)
(setqf (getfiled "选择文件夹并任意选取一个文件,请先剔除无需处理文件"
"C:\\Temp\\1\\"
"dwg"
0
)
f (vl-filename-directory f)
f (mapcar '(lambda (x) (strcat f "\\" x))
(vl-directory-files f "*.dwg" 1)
)
)
(setq tmp (open (setq file (strcat (getenv "TEMP") "\\tmp.scr")) "w"))
(foreach n f
(write-line (strcat "_.open " n "") tmp)
(write-line "(setq ss(ssget \"x\" '((0 . \"CIRCLE\") (40 . 0.5))))" tmp)
(write-line "(if ss(repeat(setq n(sslength ss))(setq en(ssname ss(setq n(1- n)))endate(entget en)pt(cdr(assoc 10 endate)))" tmp)
(write-line "(entmake(list(cons 0\"LINE\")(cons 10(list(-(car pt)5)(cadr pt)(caddr pt)))(cons 11(list(+(car pt)5)(cadr pt)(caddr pt)))))" tmp)
(write-line "(entmake(list(cons 0\"LINE\")(cons 10(list(car pt)(-(cadr pt)5)(caddr pt)))(cons 11(list(car pt)(+(cadr pt)5)(caddr pt)))))" tmp)
(write-line "(entdel en)))" tmp)
(write-line "_.qsave _.close" tmp)
)
(close tmp)
(command ".script" file)
(vl-file-delete file)
(princ)
) 本帖最后由 xiaolong1487 于 2022-5-19 19:24 编辑
(defun c:tt (/ en endate n pt ss)
(setq ss (ssget "x" '((0 . "CIRCLE") (40 . 0.5))))
(if ss
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n)))
endate (entget en)
pt (cdr (assoc 10 endate))
)
(entmake (list '(0 . "LINE") (cons 10 (list (- (car pt) 5) (cadr pt) (caddr pt))) (cons 11 (list (+ (car pt) 5) (cadr pt) (caddr pt)))))
(entmake (list '(0 . "LINE") (cons 10 (list (car pt) (- (cadr pt) 5) (caddr pt))) (cons 11 (list (car pt) (+ (cadr pt) 5) (caddr pt)))))
(entdel en))
)
(princ)
) 圆心加十字
1 可以插入一个块
2 可以绘制一个十字
3 直接用DIMCENTER(变脸DIMCEN控制尺寸,实际长度是DIMCENTER *dimscale。所以为0的时候无法绘制) xiaolong1487 发表于 2022-5-19 19:21
能帮忙改成dxf格式吗? xiaolong1487 发表于 2022-5-20 12:27
http://bbs.mjtd.com/forum.php?mod=image&aid=120248&size=300x300&key=5c16635bce82db1a&nocache=yes&type=fixnone 谢谢!dxf是可以了,但原本的圆心加十字标记功能没了,现在等于是打开dxf再另存dxf,图纸没有发生变化 wutao8282 发表于 2022-5-20 14:37
谢谢!dxf是可以了,但原本的圆心加十字标记功能没了,现在等于是打开dxf再另存dxf,图纸没有发生变化
你这个不是改所有圆,是只改半径为0.5的圆 (40 . 0.5) 本帖最后由 wutao8282 于 2022-5-20 20:24 编辑
xiaolong1487 发表于 2022-5-20 15:17
你这个不是改所有圆,是只改半径为0.5的圆 (40 . 0.5)
原来就是改所有圆啊。在圆心加十字标,我又测试了一遍,半径0.5的圆也没有被修改 wutao8282 发表于 2022-5-20 20:17
原来就是改所有圆啊。在圆心加十字标,我又测试了一遍,半径0.5的圆也没有被修改
自己有空调试一下了,我这没问题!要改所有直径圆去需改"(setq ss(ssget \"x\" '((0 . \"CIRCLE\") (40 . 0.5))))"为"(setq ss(ssget \"x\" '((0 . \"CIRCLE\"))))"
页:
[1]
2