单线变双线能不能改成这样

wjnnan

这是论坛里以为兄弟的单线改双线的源码

;**********************************单线变双*************************
(defun c:bs (/ oldlayer dis o)
  (prompt "***单线变双线***")
  (command "undo" "be")
  (setq oldlayer (getvar "CLAYER"))
  (setvar "cmdecho" 0)
  (command "-layer" "M" "管径" "" "Color" 2 "" "l" "continous" "" "")
(setq dis (getreal "\n输入双线间的距离:"))
  (setq o 1)
  (while o
    (setq o nil)
    (setq o (entsel "\n选择要变双的线条< (右键退出)"))
    (command "offset" (/ dis 2) o '(-9999999 -9999999) "")
    (command "change" (ssget "l") "" "p" "la" "管径" "")
    (command "offset" (/ dis 2) o '(9999999 9999999) "")
    (command "change" (ssget "l") "" "p" "la" "管径" "")
    (command "erase" o "")
  )
  (setvar "CLAYER" oldlayer)
  (command "undo" "e")
)

能不能改成这样，人工输入一条虚线(直线或多义线)（并自动归入自定义的图层1），以这条虚线为基准，再给出双线间的距离,形成的实线线型的pline线，线宽w 为30，（并归入自定义的图层2），完成以上操作后，以输入的虚线中点放大1.5倍，本人基础太差，现在还不能独立修改，那位帮帮忙，给改一下

具体见下图

坏坏的芝麻

我改了一下，试验好使~  你试试吧~

(defun c:bs()
    (command "undo" "be")
    (command "celtype" "ACAD_ISO03W100")
    (setq pt1 (getpoint "请选择第1点"))
    (princ "\n")
    (setq pt2 (getpoint "请选择第2点"))
    (princ "\n")
    (command "line" pt1 pt2 "")
    (setq o1 (entlast))
    (command "change" o1 "" "p" "la" "zdy1" "")
    (command "celtype" "Continuous")
    (setq dis (getreal "\n输入双线间的距离:"))
    (command "pline" pt1 "w" 30 30 pt2 "")
    (setq o (entlast))

    (command "offset" (/ dis 2) o '(-9999999 -9999999) "")
    (command "change" (entlast) "" "p" "la" "zdy2" "")
    (command "offset" (/ dis 2) o '(9999999 9999999) "")
    (command "change" (entlast) "" "p" "la" "zdy2" "")
    (command "erase" o "")

    (command "scale" o1 "" (middle pt1 pt2) 1.5)
)

(defun middle(pt1 pt2)
    (setq x (/ (+ (car pt1)     (car pt2)) 2))
    (setq y (/ (+ (cadr pt1)    (cadr pt2)) 2))
    (setq z (/ (+ (caddr pt1)   (caddr pt2)) 2))
    (list x y z)
)

坏坏的芝麻

(command "celtype" "ACAD_ISO03W100") ;;这句是虚线的线型
(command "celtype" "Continuous") ;;;这个是实线的线型
你可以根据自己有的线型做相应修改

wjnnan

坏坏的芝麻 发表于 2014-8-1 16:21
我改了一下，试验好使~  你试试吧~

(defun c:bs()

不错，基本达到目的，自己又修改了一下，给分
(defun c:bs()
    (command "undo" "be")
    (command "celtype" "dashed2")
  (if  (=  (tblsearch "layer" "管中心线") nil)
          (command "layer" "m" "管中心线" "c" "2" "" "")
    )
  (if  (=  (tblsearch "layer" "管壁") nil)
          (command "layer" "m" "管壁" "c" "2" "" "")
    )
    (setq pt1 (getpoint "请选择第1点"))
    (princ "\n")
    (setq pt2 (getpoint "请选择第2点"))
    (princ "\n")
    (command "line" pt1 pt2 "")
    (setq o1 (entlast))
    (command "change" o1 "" "p" "la" "管中心线" "")
    (command "celtype" "Continuous")
    (setq dis (getreal "\n输入双线间的距离:"))
    (command "pline" pt1 "w" 30 30 pt2 "")
    (setq o (entlast))

    (command "offset" (/ dis 2) o '(-9999999 -9999999) "")
    (command "change" (entlast) "" "p" "la" "管壁" "")
    (command "offset" (/ dis 2) o '(9999999 9999999) "")
    (command "change" (entlast) "" "p" "la" "管壁" "")
    (command "erase" o "")

    (command "scale" o1 "" (middle pt1 pt2) 1.5)
)

(defun middle(pt1 pt2)
    (setq x (/ (+ (car pt1)     (car pt2)) 2))
    (setq y (/ (+ (cadr pt1)    (cadr pt2)) 2))
    (setq z (/ (+ (caddr pt1)   (caddr pt2)) 2))
    (list x y z)
)