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

woxin168

多年前登陆过明经通道，后来不常来了，用户名也忘了，最近见此论坛还是亲切，再次注册，发段小码，以示纪念。
命令说明：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        i  0
        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)
)

tomonkey239

感谢大佬，学习了。。。。。

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

mashanjie

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输入偏移距离<可直接量取>:"))   这个<可直接量取>改成自己能修改距离，另外这个也没有偏移能指定颜色，比如当前图元是白色，偏移后的是绿色。麻烦大哥帮我完善一下这两项可行？

paulpipi

真的挺好用
，谢谢分享

woxin168

好用就好，不用客气。

LuckyClover

感谢表哥分享

刚开始

好用，感谢分享。

lzspain

感谢大佬分享！

行天下

好用，感谢分享。

lxl217114

欢迎回家，谢谢分享。

不一样地设计

感谢分享，常来论坛