双向偏移命令源码---再次注册，发贴纪念
多年前登陆过明经通道，后来不常来了，用户名也忘了，最近见此论坛还是亲切，再次注册，发段小码，以示纪念。命令说明：CAD带的offset命令只能单向，这个可以双向，可以多选，选择到的线改中心线。两侧再生成偏移线。
;;双向偏移
(defun c:fff (/ dist x ss i nb ept)
(setq dist (getreal "\n 请输入偏移量，回车按<20>执行"))
(if (= dist nil)
(setq dist 20)
)
(princ "\n请选择需要双向偏移的对象: ")
(setq ss (ssget ":S" '((0 . "Arc,Circle,Ellipse,*Line"))))
(if (/= ss nil)
(progn
(if (and dist ss)
(vlax-for ss (vla-get-activeselectionset
(vla-get-activedocument (vlax-get-acad-object))
)
(mapcar '(lambda (x) (vla-offset ss x))
(list dist (- dist))
)
)
)
)
)
;(textpage)
;(if (= (tblsearch "layer" "0") nil) ;没有0层就弄个0层
;(command "layer" "n" "0" "C" "7" "" "l" "continuous" "" "")
;)
(if (= (tblsearch "layer" "5") nil) ;没有5层就弄个5层
(command "layer" "n" "5" "C" "5" "" "l" "center" "" "")
)
(setq i0
nb (sslength ss)
)
(princ (strcat "\n选择的图元数量= " (rtos nb) "\n欢迎使用！"))
(repeat nb
(progn
(setq ept (entget (ssname ss i))) ;把选定的线改为中心线
(entmod (subst (cons 8 "5") (assoc 8 ept) ept))
(setq i (+ 1 i))
)
)
(princ)
)
感谢大佬:lol，学习了。。。。。 hubeiwdlue 发表于 2023-9-26 08:50
子函数 (zcx) 能提供一下吗？
我修改了一下，横线改成白色实线，具体如下：0层。
(defun zcx()
(setvar "osmode" 0)
(setq p2 (polar p1 0 10)
x1 (car p1 )
x2 (car p2)
le (* (- (strlen txt) 0.2) (* zg 0.75))
)
(if (< x2 x1)
(setq pp (polar p2 pi le)
p3 (polar pp (/ pi 2) zj))
(setq pp (polar p2 0 le)
p3 (polar p2 (/ pi 2) zj))
)
(entmakeX (list '(0 . "LINE") (cons 10 p1) (cons 11 p2)))
(setq ent1 (entget(entlast)))
(entmakeX (list '(0 . "LINE") (cons 10 p2) (cons 11 pp)))
(setq ent2 (entget(entlast)))
;(entmakex (list '(0 . "text") (cons 1 txt)(cons 7 "STANDARD")(cons 10 p3) (cons 40 zg)))
(command "text" P3 zg 0 txt)
(setq ent3 (entget(entlast)))
(princ (textbox ent3))
(setq le1 (caadr (textbox ent3)))
(setq le (* 1.2 le1)
jl (* 0.1 le1))
;(setvar "osmode" 512)
;(princ "\n ********2*osmode 512*******")
(while (= (car (setq mouse (grread t 1 0))) 5)
(setq pt (cadr mouse))
(if (>= (car pt)(car p1))
(progn
(entmod (subst (cons 11 pt)(assoc 11 ent1) ent1))
(setq ent2 (subst (cons 10 pt)(assoc 10 ent2) ent2))
(setq ent2 (subst (cons 8"0") (assoc 8 ent2) ent2))
(entmod (subst (cons 11 (polar pt 0 le))(assoc 11 ent2) ent2))
(setq ent3 (subst '(72 . 0) (assoc 72 ent3) ent3))
(entmod (subst (cons 10 (list (+ (car pt) jl) (+ (cadr pt) zj)))(assoc 10 ent3) ent3))
)
(progn
(entmod (subst (cons 11 pt)(assoc 11 ent1) ent1))
(setq ent2 (subst (cons 10 pt)(assoc 10 ent2) ent2))
(setq ent2 (subst (cons 8"0") (assoc 8 ent2) ent2))
(entmod (subst (cons 11 (polar pt pi le))(assoc 11 ent2) ent2))
(setq ent3 (subst '(72 . 2) (assoc 72 ent3) ent3))
(setq ent3 (subst (cons 10 (list (- (car pt) jl) (+ (cadr pt) zj)))(assoc 10 ent3) ent3))
(entmod (subst (cons 11 (list (- (car pt) jl) (+ (cadr pt) zj)))(assoc 11 ent3) ent3))
)
)
);end while
(princ)
) woxin168 发表于 2023-9-24 17:17
改倒是可以改，但是选取偏置后的图元比较麻烦。有个简单办法，可否解决你的问题：就是：运行前，把待偏置 ...
(defun c:sx (/ getds ss i e obj)
(vl-load-com)
(setvar 'cmdecho 0)
(initget 2)
(setq getds (getdist "\n输入偏移距离<可直接量取>:"))
(if (not getds)
(exit)
)
(setq ss (ssget '((0 . "Arc,Circle,Ellipse,*Line"))))
(if (not ss)
(exit)
)
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
obj (vlax-ename->vla-object E)
i (1+ i)
)
(vl-catch-all-apply 'vla-offset (list obj getds))
(vl-catch-all-apply 'vla-offset (list obj (* getds -1)))
)
(if (not (getpoint "\n按鼠标左键不删除源对象 <空格删除>"))
(command "_.ERASE" (ssget "p") "")
)
(princ)
)
这个大哥能不能帮我修改一下， (setq getds (getdist "\n输入偏移距离<可直接量取>:")) 这个<可直接量取>改成自己能修改距离，另外这个也没有偏移能指定颜色，比如当前图元是白色，偏移后的是绿色。麻烦大哥帮我完善一下这两项可行？:handshake:handshake 真的挺好用
，谢谢分享 好用就好，不用客气。 感谢表哥分享 好用，感谢分享。 感谢大佬分享！ 好用，感谢分享。 欢迎回家，谢谢分享。 感谢分享，常来论坛