双向偏移命令源码---再次注册，发贴纪念

woxin168

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)
  )

hubeiwdlue

woxin168 发表于 2023-9-26 21:31
我修改了一下，横线改成白色实线，具体如下：0层。
(defun zcx()
    (setvar "osmode" 0)

谢谢大佬。

woxin168

能帮到您就好，不客气啦！

ljpnb

好久没来了，也发一个简单实用的对双向偏移
;;;简单双向偏移
(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)
)

acoff

感谢分享，常来论坛