[討論]單線轉雙線

想請教各位大師

有沒有方法可以把"L"繪出的線轉成"ML"的雙線呢??

另外提供在找這個問題的時候意外找到的LISP

可惜不是我要的功能

LISP簡介可以將線轉為雙條單線。(不知道這樣轉分享有沒有問題先設定成回復可見，不行的話再麻煩蘋果爸幫忙刪除了)

代碼:


(defun arcsx(ename dist / bigarc entdata entdata1 newlayer rnew rnewlist roldlist smallarc)
 (setq entdata(entget ename))
 (setq roldlist(assoc 40 entdata)
rnew    (cdr roldlist)
rnew    (+ rnew (* dist 0.5))
rnewlist(cons 40 rnew)
newlayer(cons 8 (getvar "clayer"))
entdata1(subst rnewlist roldlist entdata)
entdata1(subst newlayer (assoc 8 entdata1) entdata1)
 )

  (setq ss (entmake entdata1))

 (setq bigarc (vlax-ename->vla-object(entlast)))

 (setq rnew    (- rnew dist)
rnewlist(cons 40 rnew)
newlayer(cons 8 (getvar "clayer"))
entdata1(subst rnewlist roldlist entdata)
entdata1(subst newlayer (assoc 8 entdata1) entdata1)
 )
 (entmake entdata1)
 (setq smallarc (vlax-ename->vla-object(entlast)))
 (list smallarc bigarc)
)




(defun linesx(ename dist / ang entdata  pt1 pt2 sxpt1 sxpt2 sxpt3 sxpt4 xk)
   (setq xk (* dist 0.5)
 entdata(entget ename)
 pt1 (cdr(assoc 10 entdata))
 pt2 (cdr(assoc 11 entdata))
 ang (+(angle pt1 pt2) (* 0.5 pi))
 sxpt1 (polar pt1 ang xk)
 sxpt2 (polar pt2 ang xk)
   )
   (entmake (list (cons 0 "LINE")(cons 10 sxpt1)(cons 11 sxpt2)(cons 8 (getvar "clayer"))))
   (setq ang (+ pi ang)
 sxpt3 (polar pt1 ang xk)
 sxpt4 (polar pt2 ang xk)
   )
   (entmake (list (cons 0 "LINE")(cons 10 sxpt3)(cons 11 sxpt4)(cons 8 (getvar "clayer"))))
   (entmake (list (cons 0 "LINE")(cons 10 sxpt1)(cons 11 sxpt3)(cons 8 (getvar "clayer"))))
   (entmake (list (cons 0 "LINE")(cons 10 sxpt2)(cons 11 sxpt4)(cons 8 (getvar "clayer"))))
)


(defun pipefillet(ename1 ename2 r / entdata1 entdata2 inter pt1 pt11 pt12 pt2 pt21 pt22 oldlayer acadobj)
 (setq entdata1 (entget ename1)
entdata2 (entget ename2)
pt11 (cdr(assoc 10 entdata1))
pt12 (cdr(assoc 11 entdata1))
pt21 (cdr(assoc 10 entdata2))
pt22 (cdr(assoc 11 entdata2))
inter(inters pt11 pt12 pt21 pt22)
pt1  (if (> (distance pt11 inter)(distance pt12 inter)) pt11 pt12)
pt2  (if (> (distance pt21 inter)(distance pt22 inter)) pt21 pt22)
pt3  (polar inter (angle inter pt1) (* r 1.0))
pt4  (polar inter (angle inter pt2) (* r 1.0))
 )
 
 (setvar "filletrad" r)
 (setq acadobj (vlax-get-acad-object))
 (vla-zoomcenter acadobj (vlax-3d-point inter) (* r 4.0))
 (setq oldlayer (getvar "clayer"))
 (setvar "cmdecho" 0)
 (setvar "clayer" (cdr (assoc 8 entdata1)))
 (command "fillet" pt3 pt4)
 (setvar "clayer" oldlayer)
 (setvar "cmdecho" 1)
 (entlast)
)



(defun pipesfillet(liness r / ename1 ename2 entdata1 entdata2 index1 index2 pt1 pt2 pt3 pt4)
 (setq index1 0)
 (setq arcss (ssadd))
 (setq acadobj (vlax-get-acad-object))
 (setq acdoc   (vla-get-activedocument acadobj))
 (vla-startundomark acdoc)
 (repeat (- (sslength liness) 1)
   (setq ename1 (ssname liness index1))
   (setq entdata1 (entget ename1))
   (setq pt1 (cdr(assoc 10 entdata1)))
   (setq pt2 (cdr(assoc 11 entdata1)))
   (setq  index2 (1+ index1))
   
   (while (< index2 (sslength liness))
     (setq ename2 (ssname   liness index2))
     (setq index2 (1+ index2))
     (setq entdata2(entget ename2))
     (setq pt3 (cdr (assoc 10 entdata2)))
     (setq pt4 (cdr (assoc 11 entdata2)))
     (if (inters pt1 pt2 pt3 pt4)  (setq arcss (ssadd (pipefillet ename1 ename2 r) arcss)))
   )
   (setq index1 (1+ index1))
 )

 (vla-endundomark acdoc)
 arcss
)



;;;主函數選擇中心線變為管道
(defun c:pd( / arcss dw dw_index dw_list ename index linetype pipess r r_list)
 (vl-load-com)
;;;
;;;  (setq DW_list (list 57 76 89 108 133 159 194 319 245 273 325 377 426 480 530))
;;;  (setq R_list  (list 75 95 114 152 190 229 270 305 340 381 457 566 639 720 795))

 (setq dw (getdist "輸入管道外徑<159>: "))
 (if (null dw) (setq dw 159.0))
;;;  (setq dw_index (where_member dw dw_list))
;;;  (if (null dw_index) (progn (alert "\n你輸入的管道外徑不標準: ") (exit)))
;;;
;;;  
 (setq r  (getreal "\n輸入彎頭轉彎半徑<500>: "))
 (if (null r) (setq r 500.0))
;;;  (if (null r)(setq r (nth dw_index r_list)))

 (princ "\n請選擇管道中心線: ")
 (setq pipess (ssget (list (cons 0 "line"))))
 (setq arcss (pipesfillet pipess r))
 (setq index 0)
 (repeat (sslength pipess)
   (setq ename (ssname pipess index)
 index (1+ index)
 linetype (cdr(assoc 0 (entget ename)))
   )
   (if (= linetype "LINE")
       (linesx ename dw)
       (arcsx ename dw)
   )
 )
 (setq index 0)
 (repeat (sslength arcss)
   (setq ename (ssname arcss index)
 index (1+ index)
 linetype (cdr(assoc 0 (entget ename)))
   )
   (arcsx ename dw)
 )
 (princ)
 
)


L轉成ML的程式...這個沒有用過～
我想程式可能不好寫！
謝謝你分享網路的程式～

還在努力研究，如果有幸自己摸索出來再來分享~

感覺程式的方向是1.判斷選取線之起點&終點的座標2.刪除3.在原座標繪製ML

新手還在嘗試中

嘗試寫了大致上功能都有了，可惜不能一次選取多條線，有方法解決嗎?

(defun c:mcir()

(setvar "cmdecho" 0)

(setq en (entsel "Select a LINE:"))

(setq en_data (entget (car en)))

(setq pts (assoc 10 en_data))

(setq pt1 (cdr pts))  

(setq pte (assoc 11 en_data))

(setq pt2 (cdr pte))

(setq a(getreal"size:"))

(setq z(getstring"T:上 Z:中 B:下"))

(command "mline" "j" z "s" a pt1 pt2 "")

(princ))

謝謝大大分享!來看看!

JJacktom 大大 :
程式中的這一段

(setq a (getreal "Size:"))

更改成這樣

(setq a (getdist "Size:"))

User 可以鍵盤輸入 也 可以用滑鼠輸入 是不是會方便一些 ?
個人想法 , 提出來供大大參考參考

tomlin_uf012720 寫到:JJacktom 大大 :
程式中的這一段

(setq a (getreal "Size:"))

更改成這樣

(setq a (getdist "Size:"))

User 可以鍵盤輸入 也 可以用滑鼠輸入 是不是會方便一些 ?
個人想法 , 提出來供大大參考參考

這樣子的確方便，程式思慮老量很清楚～

謝謝版主無私的分享 讓我在工作上有很大的進步

如果可以轉真的是福音啊

如果要一次全選的話...
可以考慮用SSGET...
(princ "\n請選取線:" )
(setq in 0 )
(setq en (ssget '((0 . "LINE"))))
(repeat (sslength en )
(setq pts (cdr (assoc 10 (entget (ssname s_h in )))))
.
.
.
(setq in (1+ in ))
) ; repeat.end
這樣就可以全選了...

感謝大大無私地分享......感恩