AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~

[討論]單線轉雙線

向下

[討論]單線轉雙線

發表 由 jjacktom 于 2016-03-10, 14:48

想請教各位大師

有沒有方法可以把"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)
 
)
avatar
jjacktom
初級會員
初級會員

文章總數 : 46
年齡 : 30
來自 : 桃園
職業 : 工程師
愛好 : 桌遊
個性 : 活潑
使用年資 : 新手
使用版本 : 2012
積分 : 2
經驗值 : 2044
威望值 : 66
注冊日期 : 2013-09-10
經典問與答讀者 藍鵲634號
男 天蝎座 兔

回頂端 向下

回復: [討論]單線轉雙線

發表 由 Tiger&蘋果爸 于 2016-03-10, 16:38

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

____________________________________________________________________________________
avatar
Tiger&蘋果爸
系統管理員
系統管理員

文章總數 : 17814
年齡 : 42
來自 : 台北市文山區
職業 : AutoCAD顧問
愛好 : 蹓狗/戶外活動/拍照
個性 : 幽默/樂觀/善良
使用年資 : 15↑
使用版本 : AutoCAD 2016
經驗值 : 68052
威望值 : 13259
注冊日期 : 2008-04-23
2D基礎函授 2D進階函授 3D基礎函授 https://i11.servimg.com/u/f11/19/71/67/71/2d3d10.png2D+3D線上 顧問外掛程式 經典問與答讀者 藍鵲1號
2009聚會勳章 2010聚會勳章 2011聚會勳章 2012聚會勳章 2013勳章-2D基礎 2014聚會勳章 2015聚會勳章 2016聚會勳章 串連貼紙成功 男 水瓶座 兔

http://mypaper.pchome.com.tw/kv1012tiger

回頂端 向下

回復: [討論]單線轉雙線

發表 由 jjacktom 于 2016-03-10, 22:51

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

感覺程式的方向是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))
avatar
jjacktom
初級會員
初級會員

文章總數 : 46
年齡 : 30
來自 : 桃園
職業 : 工程師
愛好 : 桌遊
個性 : 活潑
使用年資 : 新手
使用版本 : 2012
積分 : 2
經驗值 : 2044
威望值 : 66
注冊日期 : 2013-09-10
經典問與答讀者 藍鵲634號
男 天蝎座 兔

回頂端 向下

回復: [討論]單線轉雙線

發表 由 kimtime 于 2016-04-09, 17:36

謝謝大大分享!來看看!
avatar
kimtime
一般會員
一般會員

文章總數 : 114
年齡 : 33
來自 : 台中
職業 : 專案主任工程師
愛好 : 看書、運動、打電腦
個性 : 內向
使用年資 : 7年
使用版本 : 2018
經驗值 : 2593
威望值 : 82
注冊日期 : 2012-11-08
2D基礎函授 3D基礎函授 經典問與答讀者 藍鵲674號
男 摩羯座 鼠

回頂端 向下

回復: [討論]單線轉雙線

發表 由 tomlin_uf012720 于 2016-04-29, 17:03

JJacktom 大大 :
程式中的這一段

(setq a (getreal "Size:"))

更改成這樣

(setq a (getdist "Size:"))

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

文章總數 : 14
年齡 : 45
來自 : 桃園縣
職業 : 工程師(空調)
愛好 : 發呆,看小說,寫Lisp小程式
個性 : 條直
使用年資 : 約 17 年
使用版本 : 2008
經驗值 : 2684
威望值 : 6
注冊日期 : 2011-05-13
男 雙魚座 牛

回頂端 向下

回復: [討論]單線轉雙線

發表 由 Tiger&蘋果爸 于 2016-04-29, 17:37

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

(setq a (getreal "Size:"))

更改成這樣

(setq a (getdist "Size:"))

User 可以鍵盤輸入 也 可以用滑鼠輸入 是不是會方便一些 ?
個人想法 , 提出來供大大參考參考
這樣子的確方便,程式思慮老量很清楚~
熱情

____________________________________________________________________________________
avatar
Tiger&蘋果爸
系統管理員
系統管理員

文章總數 : 17814
年齡 : 42
來自 : 台北市文山區
職業 : AutoCAD顧問
愛好 : 蹓狗/戶外活動/拍照
個性 : 幽默/樂觀/善良
使用年資 : 15↑
使用版本 : AutoCAD 2016
經驗值 : 68052
威望值 : 13259
注冊日期 : 2008-04-23
2D基礎函授 2D進階函授 3D基礎函授 https://i11.servimg.com/u/f11/19/71/67/71/2d3d10.png2D+3D線上 顧問外掛程式 經典問與答讀者 藍鵲1號
2009聚會勳章 2010聚會勳章 2011聚會勳章 2012聚會勳章 2013勳章-2D基礎 2014聚會勳章 2015聚會勳章 2016聚會勳章 串連貼紙成功 男 水瓶座 兔

http://mypaper.pchome.com.tw/kv1012tiger

回頂端 向下

回復: [討論]單線轉雙線

發表 由 jenniferaptg 于 2016-09-15, 23:59

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

jenniferaptg
初級會員
初級會員

文章總數 : 117
年齡 : 44
來自 : taiwan
職業 : cafe
愛好 : 電腦
個性 : 平易近人
使用年資 : 15
使用版本 : 用最熟的那一版
經驗值 : 3980
威望值 : 30
注冊日期 : 2009-01-30
藍鵲136號
女 雙子座 虎

回頂端 向下

回復: [討論]單線轉雙線

發表 由 minami2588 于 2016-11-11, 14:04

如果可以轉真的是福音啊

minami2588
一般會員
一般會員

文章總數 : 120
年齡 : 48
來自 : TP
職業 : 工程
愛好 : 唱歌
個性 : 樂觀開朗
使用年資 : 2D 10年
使用版本 : 2014
經驗值 : 4023
威望值 : 48
注冊日期 : 2008-10-23
藍鵲559號
女 雙子座 狗

回頂端 向下

回復: [討論]單線轉雙線

發表 由 devinchou 于 2016-11-21, 21:28

如果要一次全選的話...
可以考慮用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
這樣就可以全選了...
avatar
devinchou
初級會員
初級會員

文章總數 : 49
年齡 : 40
來自 : 基隆
職業 : 鋼筋檢料
愛好 : 寫作.閱讀.烹飪
個性 : 懶小孩一枚
使用年資 : 每天
使用版本 : 2006.2008
積分 : 2
經驗值 : 1664
威望值 : 147
注冊日期 : 2015-02-15
男 天蝎座 蛇

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章