CAD线号自动编号与排序[源码]

pengl86 · 发表于 2019-2-1 11:39

(defun c:chn ()
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(setq ll (acet-ss-to-list ss))
(initget "LD LU RD RU DL DR UL UR")
(setq tw (getkword "\n[Index:/DL/DR/LD/LU/RD/RU/UL/UR]<DL>:"))
(if tw nil (setq tw "DL"))
(cond
((or (= tw "DL")(= tw "DR"))
(setq ll (sorty+ ll))
(if (= tw "DL")(setq ll (sortx+ ll))(setq ll (sortx- ll)) )
)
((or (= tw "LD")(= tw "LU"))
(setq ll (sortx+ ll))
(if (= tw "LD")(setq ll (sorty+ ll))(setq ll (sorty- ll)) )
)
((or (= tw "RD")(= tw "RU"))
(setq ll (sortx- ll))
(if (= tw "RD")(setq ll (sorty+ ll))(setq ll (sorty- ll)) )
)
((or (= tw "UL")(= tw "UR"))
(setq ll (sorty- ll))
(if (= tw "UL")(setq ll (sortx+ ll))(setq ll (sortx- ll)) )
)
)
(setq qz (getstring "\n请输入前缀相同的部分: "))
(setq sn (getint "\n输入开始编号 <1>:"))
(setq in (getint "\n输入增量 <1>:"))
(setq cr (getint "\n输入颜色 1：红 2：黄 3：绿 5：蓝 7：白 <7>:"))
(setq zt (getstring "\n输入字体 /宋体 /ROMANS /工程字 /WD /Standard <宋体>: "))
(if sn nil (setq sn 1))
(if in nil (setq in 1))
(if cr nil (setq cr 7))
(if (= zt "") (setq zt "宋体"))
(foreach i ll
(setq obj (vlax-ename->vla-object i))
(vla-put-textstring obj (strcat qz (itoa sn)))
(vla-put-stylename obj zt)
;设置字体
(vla-put-color obj cr)
;设置字体颜色，1：红色 2：黄色 3：绿色 5：蓝 7：白
(setq sn (+ sn in))
)
)
;
(defun sortx+ (lst)
(setq lst (vl-sort lst '(lambda (p1 p2)(< (car (cdr (assoc 10 (entget p1))))
(car (cdr (assoc 10 (entget p2))))))))
)
(defun sortx- (lst)
(setq lst (vl-sort lst '(lambda (p1 p2)(> (car (cdr (assoc 10 (entget p1))))
(car (cdr (assoc 10 (entget p2))))))))
)
(defun sorty+ (lst)
(setq lst (vl-sort lst '(lambda (p1 p2)(< (cadr (cdr (assoc 10 (entget p1))))
(cadr (cdr (assoc 10 (entget p2))))))))
)
(defun sorty- (lst)
(setq lst (vl-sort lst '(lambda (p1 p2)(> (cadr (cdr (assoc 10 (entget p1))))
(cadr (cdr (assoc 10 (entget p2))))))))
)

pengl86 · 发表于 2019-2-1 11:40

CAD批量打印_单排等距.lsp

(defun c:mdy()
(setvar "osmode" 0)
(setvar "osmode" 1)
(setq fx (getstring "\n 输入图形方向 [纵向(P)/横向(L)] <横向>: "))
(if(= fx "P")(setq fx "P")(setq fx "L"))
(setq PN (getstring "\n 输入打印机名称<Adobe PDF>: "))
(if(= PN "")(setq PN "Adobe PDF"))
(setq zz (getstring "\n 输入打印偏移 (x,y) <0.00,0.00>或 [居中打印(C)] <C>: "))
(if(= zz "")(setq zz "C"))
(setq AS (getint "\n输入需要打印圖紙數量<1>: "))
(if AS nil (setq AS 1))
(setq VDI (getdist "\n輸入||||間距<500.00>: "))
(if VDI nil (setq VDI 500.00))
(setq P1 (getpoint "\n***框選零件圖的左下點: "))
(setq P2 (getcorner p1 "\n***框選零件圖的右上點: "))
(setq sn 0)
(while (/= sn AS)
(setq PP (polar p1 0 (* VDI sn)))
(setq MP (polar p2 0 (* VDI sn)))
(setq sn (+ sn 1))
(command "-plot" "y" "model" PN "a4" "m" fx "n" "w" PP MP "f" zz "y" "monochrome.ctb" "y" "n" "n" "n" "y" )
)
(setvar "osmode" 33)
)

20060510412 · 发表于 2019-2-2 11:28

pengl86 发表于 2019-2-1 11:40
CAD批量打印_单排等距.lsp

最好给个动态演示，这样看不清楚效果

祥云-火炬 · 发表于 2023-11-27 17:16

谢谢楼主分享

wangsr · 发表于 2023-10-25 20:56

我也想学编程

zwf9900 · 发表于 2023-9-29 09:26

如果有动画演示就更好

金鹅起飞 · 发表于 2023-9-28 10:18

谢谢楼主分享源码，支持你

下文没句号。 · 发表于 2023-8-15 01:41

一起来看下吧

jh3030912 · 发表于 2023-8-4 18:04

可以进行特定文字编号排序吗？

willing0 · 发表于 2022-6-7 18:31

分感谢楼主的大公无私

uualice2020 · 发表于 2022-4-16 09:04

多谢大神的分享，谢谢

vladimir · 发表于 2022-2-13 08:56

非常不错的代码，谢谢楼主分享

账号		自动登录	找回密码
密码			注册

CAD线号自动编号与排序[源码]

评分

相关帖子