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-26 21:31
我修改了一下，横线改成白色实线，具体如下：0层。
(defun zcx()
(setvar "osmode" 0)
谢谢大佬。
能帮到您就好，不客气啦！
好久没来了，也发一个简单实用的对双向偏移
;;;简单双向偏移
(defun c:OO ()
;;;(vl-load-com)
(if (/= DL nil)
(setq info (strcat "\n当前的对称偏移距离为<" (rtos DL) ">: "))
(setq info (strcat "\n当前的对称偏移距离为<>: "))
)
(setq dist (getdist info))
(if (= dist nil)
(setq dist dl)
)
(setq myline (vlax-Ename->Vla-Object
(car (entsel "\n 请选择偏移的中心线:"))
)
)
(setq dl dist)
(setq dist (/ dist 2))
(setq offLine1 (vla-Offset myline dist))
(setq offLine2 (vla-Offset myline (- dist)))
(princ)
)
感谢分享，常来论坛