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

Join the forum, it's quick and easy

AutoCAD顧問
還沒有註冊嗎...即日起免費註冊,所有最完整的AutoCAD討論、教學及資源都在論壇裡喔~
AutoCAD顧問
Would you like to react to this message? Create an account in a few clicks or log in to continue.

想問關於Lisp問題(已解決)

3 posters

向下

想問關於Lisp問題(已解決) Empty 想問關於Lisp問題(已解決)

發表 由 masao_8 2022-06-04, 01:55

想請問這個畫消角程式 選取矩形後如圓半徑較小出現錯誤 該如何改?

代碼:
(defun c:vv()

 (setvar "cmdecho" 0)

(setq ptlist (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'Coordinates )
       pt1 (list (car ptlist) (cadr ptlist))
       pt2 (list (caddr ptlist) (nth 3 ptlist))
       pt3 (list (nth 4 ptlist) (nth 5 ptlist))
       pt4 (list (nth 6 ptlist) (nth 7 ptlist))
)

(setq cenpt (polar PT1 (angle PT1 PT3) (/ (distance PT1 PT3) 2)));求矩形中點

(setq cenpm (/ (distance PT1 PT2) 2))
(setq cenpm2 (/ (distance PT2 PT3) 2));設定邊距離

(setq ptm (polar cenpt (* pi 0.5) cenpm2));設定點
;重新編排四點設定
(setq pt5 (polar ptm pi cenpm))

(setq pt6 (polar pt5 0 (distance PT1 PT2)))

(setq pt7 (polar pt6 (* pi 1.5) (distance PT2 PT3)))

(setq pt8 (polar pt7 pi (distance PT1 PT2)));完成設定
 
 (setq r (getint "\n半徑:"))
 (setq n (* (* r 2) 0.33))
 (setq m (* n (sqrt 2)))

 (setq osm (getvar "osmode"))

;左上角圓
 (setq p1 (polar pt5 (* pi 1.75) m))
;右上角圓
 (setq p2 (polar pt6 (* pi 1.25) m))
;右下角圓
 (setq p3 (polar pt7 (* pi 0.75) m))
;左下角圓
 (setq p4 (polar pt8 (* pi 0.25) m))

;左上角圓修剪
 (setq t1 (polar p1 (* pi 0.5) n)) ;上下方向
 (setq t2 (polar p1 pi n)) ;左右方向
 (setq t3 (polar p1 (* pi 1.75) r)) ;斜邊方向
;右上角圓修剪
 (setq t4 (polar p2 (* pi 0.5) n)) ;上下方向
 (setq t5 (polar p2 0 n)) ;左右方向
 (setq t6 (polar p2 (* pi 1.25) r)) ;斜邊方向
;右下角圓修剪
 (setq t7 (polar p3 (* pi 1.5) n)) ;上下方向
 (setq t8 (polar p3 0 n)) ;左右方向
 (setq t9 (polar p3 (* pi 0.75) r)) ;斜邊方向
;左下角圓修剪
 (setq t10 (polar p4 (* pi 1.5) n)) ;上下方向
 (setq t11 (polar p4 pi n)) ;左右方向
 (setq t12 (polar p4 (* pi 0.25) r)) ;斜邊方向

(setvar "osmode" 0)

 (command r "circle" p1 r "circle" p2 r "circle" p3 r "circle" p4 r)
 
 (command "trim" "" t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 "")

 (command "pedit" "m" "p" "" "join" "0" "")

(setvar "osmode" osm)
(setvar "cmdecho" 1)

(princ)
)
(princ)


masao_8 在 2022-06-19, 09:59 作了第 1 次修改
masao_8
masao_8
一般會員
一般會員

文章總數 : 8
年齡 : 29
來自 : 台中
職業 : 製圖
愛好 : 動漫
個性 : 內向
使用年資 : 4年
使用版本 : 2012
經驗值 : 78
威望值 : 0
注冊日期 : 2022-06-03
男 水瓶座 雞

回頂端 向下

想問關於Lisp問題(已解決) Empty 回復: 想問關於Lisp問題(已解決)

發表 由 Atsai 2022-06-08, 14:10

1.找出封閉聚合線頂點位置
2.利用頂點求出圓心位置
3.利用封閉聚合線的頂點表,利用ssget "cp"選取聚合線、圓做面域
4.將3.所得的各面域做聯集成單一面域
5.將聯集後的面域轉成pline,程式結束。

這樣的方式應該會比較好寫,只要是封閉的聚合線都可以執行。
不一定要矩型。

看了S大的回復才知道我搞錯了,原來不是圓的中心不是在頂點! 頭暈目眩



Atsai 在 2022-06-11, 17:10 作了第 1 次修改
Atsai
Atsai
中級會員
中級會員

文章總數 : 153
年齡 : 47
來自 : 台中
職業 : 工程
愛好 : 看漫畫
個性 : 樂天
使用年資 : 10
使用版本 : 2010
AutoCAD基礎篇等級 : 10星級
積分 : 8
經驗值 : 4946
威望值 : 474
注冊日期 : 2012-04-06
男 金牛座 兔

Tiger&蘋果爸 and masao_8 like this post

回頂端 向下

想問關於Lisp問題(已解決) Empty 回復: 想問關於Lisp問題(已解決)

發表 由 shenhung 2022-06-11, 15:46

想問關於Lisp問題(已解決) 4cc11

以下是我的方法.參考看看.~

1.用 LINE   我不是用聚合線..讓使用者.選LINE A 和 LINE B

2.取得A B 線長..用計算的方式.算出點PTA PTB PTC PTD 位置..

3 PTA 的P1 P2 位置用計算式  (/  半徑 (sqrt 2)) 取得  ,       (/ 5 (sqrt 2)=7.071

 PTB.PTC PTD 依此類推.~

4. ARC 用3點畫出  P1 PTA P2 ..依序畫4個位置的插角R..

剪線也用計算式.算出點位置..再用BREAK 剪斷線.~!!

以上的方式.小半徑也沒問題.~

PS :這是PTA 剛好在ARC上..如果像PTB 跟ARC有段距離.不在ARC上.又是另外的寫法.要再考慮ARC 的偏移量.

LISP 最後加入這2行.就會自動剪線.
(setq SS (ssget "c" pta ptc (list (cons 0 "ARC"))))  ;取得4角落ARC
(trim_ccline)  ;執行剪線副程式.


;剪線LISP
;--------------------------------------------------------------------------
;單獨剪線.
(defun c:Ecc() (prompt "\n***請選取插角ARC***")
              (setq ss (ssget (list (cons 0 "arc"))))
              (trim_ccline)
)
;--------------------------------------------------------------------------
(defun trim_ccline( / #50 #51 #40 #10 p50 p51 sse en1 enm i w)
(setq w 0)
(REPEAT (SSLENGTH SS)
(setq en (ssname ss W))
(setq #50 (dxfa 50 en))
(setq #51 (dxfa 51 en))
(setq #40 (dxfa 40 en))
(setq #10 (dxfa 10 en))
(setq #8  (dxfa 8  en))
(setq p50 (polar #10 #50 #40))
(setq p51 (polar #10 #51 #40))
(setq sse (ssget "c" p50 p51))
(setq i 0)
     (repeat (sslength sse)
(setq en1 (ssname sse i))
(setq enm (dxfa 0 en1))
(setq e8  (dxfa 8 en1))
(if (AND (= E8 #8 ) (= enm "LINE")) (PROGN
     (RLGT EN EN1)
     (COMMAND "BREAK" EN1 PIN1 PIN2)
   )
)
(SETQ I (1+ I))
      )
(SETQ W (1+ W))
  )
  (princ)
)
;------------------------------------------------------------------------------
;計算ARC和LINE的交點.
(DEFUN RLGT(arc lin / a1 a2 p1 p2 ps pe pc ds1 ds2 p1* r pm dlc1 dlc2
     d1 d2 lin arc ll lr pls prs)
  (setq ps (cdr (assoc 10 (entget lin))))   ;p10
  (setq pe (cdr (assoc 11 (entget lin))))   ;p11
  (setq pc (cdr (assoc 10 (entget arc))))   ;arc pt
  (setq r (cdr (assoc 40 (entget  arc))))    ;arc radius
  (setq a1 (cdr (assoc 50 (entget arc))))   ;SR1
  (setq a2 (cdr (assoc 51 (entget arc))))   ;SR2
  (setq p1 (polar pc a1 r))   ;P1
  (setq p2 (polar pc a2 r))   ;P2

  (setq pm (inters pc (polar pc (+ (angle ps pe) (/ pi 2)) 1) ps pe onseg))
  (setq dlc1 (distance pc pm))
  (if (> dlc1 r) (prompt "\n沒有交點.再試一次:")
      (progn (setq dlc2 (sqrt (- (* r r) (* dlc1 dlc1))))
     (setq pin1 (polar pm (angle ps pe) dlc2))
     (setq pin2 (polar pm (angle pe ps) dlc2))
 
)
   )
)
;-------------------------------------------------------------------------------
(defun dxfa (code entity / dxf_lis)
 (setq dxf_lis (cdr (assoc code (entget entity (list "*")))))
)
shenhung
shenhung
高級會員
高級會員

文章總數 : 264
年齡 : 55
來自 : 新北市
職業 : 塑膠模具設計.AUTOLISP
愛好 : 音樂
個性 : 隨和
使用年資 : 18年
使用版本 : 2010
積分 : 15
經驗值 : 7045
威望值 : 1111
注冊日期 : 2009-06-03
男 摩羯座 馬

Tiger&蘋果爸 and masao_8 like this post

回頂端 向下

想問關於Lisp問題(已解決) Empty 想問關於Lisp問題

發表 由 masao_8 2022-06-12, 15:19

Atsai 寫到:1.找出封閉聚合線頂點位置
2.利用頂點求出圓心位置
3.利用封閉聚合線的頂點表,利用ssget "cp"選取聚合線、圓做面域
4.將3.所得的各面域做聯集成單一面域
5.將聯集後的面域轉成pline,程式結束。

這樣的方式應該會比較好寫,只要是封閉的聚合線都可以執行。
不一定要矩型。

看了S大的回復才知道我搞錯了,原來不是圓的中心不是在頂點! 頭暈目眩


感謝回覆,目前先暫時這樣改 我對於選集的設定還不太熟 用最複雜的方式設定 姑且能用 謝謝大大們~

代碼:
(defun c:vv()

 (setvar "cmdecho" 0)
 
 (setq ptlist (Vlax-Get (Vlax-Ename->Vla-Object (car (entsel))) 'Coordinates )
      pt1 (list (car ptlist) (cadr ptlist))
      pt2 (list (caddr ptlist) (nth 3 ptlist))
      pt3 (list (nth 4 ptlist) (nth 5 ptlist))
      pt4 (list (nth 6 ptlist) (nth 7 ptlist))
)


(setq cenpt (polar PT1 (angle PT1 PT3) (/ (distance PT1 PT3) 2)));求矩形中點

(setq cenpm (/ (distance PT1 PT2) 2))
(setq cenpm2 (/ (distance PT2 PT3) 2));設定邊距離

(setq ptm (polar cenpt (* pi 0.5) cenpm2));設定點
;重新編排四點設定
(setq pt5 (polar ptm pi cenpm))

(setq pt6 (polar pt5 0 (distance PT1 PT2)))

(setq pt7 (polar pt6 (* pi 1.5) (distance PT2 PT3)))

(setq pt8 (polar pt7 pi (distance PT1 PT2)));完成設定


 (command "ucs" "world")

 (setq ss1 (ssadd)) ;將矩形加入選集
 (ssadd (entlast) ss1)

 (setq r (getint "\n半徑:"))
 (setq n (* (* r 2) 0.33))
 (setq m (* n (sqrt 2)))

 (setq osm (getvar "osmode"))

;左上角圓
 (setq p1 (polar pt5 (* pi 1.75) m))
;右上角圓
 (setq p2 (polar pt6 (* pi 1.25) m))
;右下角圓
 (setq p3 (polar pt7 (* pi 0.75) m))
;左下角圓
 (setq p4 (polar pt8 (* pi 0.25) m))

;左上角圓修剪
 (setq t1 (polar p1 (* pi 0.5) n)) ;上下方向
 (setq t2 (polar p1 pi n)) ;左右方向
 (setq t3 (polar p1 (* pi 1.75) r)) ;斜邊方向
;右上角圓修剪
 (setq t4 (polar p2 (* pi 0.5) n)) ;上下方向
 (setq t5 (polar p2 0 n)) ;左右方向
 (setq t6 (polar p2 (* pi 1.25) r)) ;斜邊方向
;右下角圓修剪
 (setq t7 (polar p3 (* pi 1.5) n)) ;上下方向
 (setq t8 (polar p3 0 n)) ;左右方向
 (setq t9 (polar p3 (* pi 0.75) r)) ;斜邊方向
;左下角圓修剪
 (setq t10 (polar p4 (* pi 1.5) n)) ;上下方向
 (setq t11 (polar p4 pi n)) ;左右方向
 (setq t12 (polar p4 (* pi 0.25) r)) ;斜邊方向


(setvar "osmode" 0)

(setq ss2 (ssadd)) ;建立消角圓選集
(setq ss3 (ssadd))
(setq ss4 (ssadd))
(setq ss5 (ssadd))
(setq ss6 (ssadd))

 (command r "circle" p1 r) ;畫消角圓
 (ssadd (entlast) ss2)
 
 (command "circle" p2 r)
 (ssadd (entlast) ss3)
 
 (command "circle" p3 r)
 (ssadd (entlast) ss4)

 (command "circle" p4 r)
 (ssadd (entlast) ss5)

 (command "region" ss1 "") ;將矩形與圓面域
 (ssadd (entlast) ss1)

 (command "region" ss2 "")
 (ssadd (entlast) ss2)

 (command "region" ss3 "")
 (ssadd (entlast) ss3)

 (command "region" ss4 "")
 (ssadd (entlast) ss4)

 (command "region" ss5 "")
 (ssadd (entlast) ss5)
 
 (command "union" ss1 ss2 ss3 ss4 ss5 "") ;將矩形與圓結合
 (ssadd (entlast) ss6)

 (command "explode" ss6 "") ;將圖形炸開
 
 (command "pedit" "m" "p" "" "join" 0 "") ;將圖形接合

 (setvar "osmode" osm) ;將系統變數恢復
 (setvar "cmdecho" 1)

 (command "ucs" "p") ;將坐標系恢復


(princ)
)
(princ)
masao_8
masao_8
一般會員
一般會員

文章總數 : 8
年齡 : 29
來自 : 台中
職業 : 製圖
愛好 : 動漫
個性 : 內向
使用年資 : 4年
使用版本 : 2012
經驗值 : 78
威望值 : 0
注冊日期 : 2022-06-03
男 水瓶座 雞

回頂端 向下

想問關於Lisp問題(已解決) Empty 回復: 想問關於Lisp問題(已解決)

發表 由 Atsai 2022-06-12, 19:04

原本以為圓心是在聚合線或的節點上,
這個是後來依樓主的圓心位置需求調整的。應該只能適用在矩形上。

代碼:

(defun c:test ()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setq qa (getvar "qaflags"))
  (setvar "osmode" 0)

  (setq r nil)
  (setq ss1 nil)

  (princ "\n請選擇矩形:")
  (setq ss1 (ssget '((0 . "*polyline"))))
  (setq r (getreal "\n請輸入半徑:"))

  (setq i 0)
  (repeat (sslength ss1)
    (setq ptlist nil)
    (setq ptlist (apply   'append
         (mapcar   '(lambda (x)
              (if (= 10 (car x))
                (list (cdr x))
              )
             )
            (entget (ssname ss1 i))
         )
       )
    )
   
    (setq pt1 (nth 0 ptlist))
    (setq pt3 (nth 2 ptlist))
    (setq ptc (polar pt1 (angle pt1 pt3) (* 0.5 (distance pt1 pt3))))
    (setq dm (/ (* (* r 2.0) (sqrt 2.0)) 3.0))

    (setq j 0)
    (repeat (length ptlist)
      (command "circle"
         (polar (nth j ptlist) (angle (nth j ptlist) ptc) dm)
         r
      )
      (setq j (1+ j))
    )

    (setq ss2 nil)
    (setq ss2 (ssget "f" ptlist))
    (command "region" ss2 "")

    (setq ss2 (ssget "f" ptlist '((0 . "region"))))
    (command "union" ss2 "")

    (if   (= (cdr (assoc 0 (entget (entlast)))) "REGION")
      (progn
   (setvar "qaflags" 1)
   (command "_.explode" (entlast) "")
   (setq ss2 (ssget "_p"))
      )
    )

    (command "_.pedit" "m" ss2 "" "j" "" "")

    (setq i (1+ i))
  )

  (setvar "osmode" os)
  (setvar "qaflags" qa)
  (princ "OK!")
  (princ)
)
Atsai
Atsai
中級會員
中級會員

文章總數 : 153
年齡 : 47
來自 : 台中
職業 : 工程
愛好 : 看漫畫
個性 : 樂天
使用年資 : 10
使用版本 : 2010
AutoCAD基礎篇等級 : 10星級
積分 : 8
經驗值 : 4946
威望值 : 474
注冊日期 : 2012-04-06
男 金牛座 兔

masao_8 likes this post

回頂端 向下

想問關於Lisp問題(已解決) Empty 回復: 想問關於Lisp問題(已解決)

發表 由 masao_8 2022-06-12, 20:13

Atsai 寫到:原本以為圓心是在聚合線或的節點上,
這個是後來依樓主的圓心位置需求調整的。應該只能適用在矩形上。

代碼:

(defun c:test ()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setq qa (getvar "qaflags"))
  (setvar "osmode" 0)

  (setq r nil)
  (setq ss1 nil)

  (princ "\n請選擇矩形:")
  (setq ss1 (ssget '((0 . "*polyline"))))
  (setq r (getreal "\n請輸入半徑:"))

  (setq i 0)
  (repeat (sslength ss1)
    (setq ptlist nil)
    (setq ptlist (apply 'append
 (mapcar '(lambda (x)
   (if (= 10 (car x))
     (list (cdr x))
   )
 )
 (entget (ssname ss1 i))
 )
 )
    )
    
    (setq pt1 (nth 0 ptlist))
    (setq pt3 (nth 2 ptlist))
    (setq ptc (polar pt1 (angle pt1 pt3) (* 0.5 (distance pt1 pt3))))
    (setq dm (/ (* (* r 2.0) (sqrt 2.0)) 3.0))

    (setq j 0)
    (repeat (length ptlist)
      (command "circle"
       (polar (nth j ptlist) (angle (nth j ptlist) ptc) dm)
       r
      )
      (setq j (1+ j))
    )

    (setq ss2 nil)
    (setq ss2 (ssget "f" ptlist))
    (command "region" ss2 "")

    (setq ss2 (ssget "f" ptlist '((0 . "region"))))
    (command "union" ss2 "")

    (if (= (cdr (assoc 0 (entget (entlast)))) "REGION")
      (progn
 (setvar "qaflags" 1)
 (command "_.explode" (entlast) "")
 (setq ss2 (ssget "_p"))
      )
    )

    (command "_.pedit" "m" ss2 "" "j" "" "")

    (setq i (1+ i))
  )

  (setvar "osmode" os)
  (setvar "qaflags" qa)
  (princ "OK!")
  (princ)
)

感謝~真厲害 我都用簡單的函數接 不過這樣寫起來很長 還在理解中 選集真的難~
不過大大的程式好像會與其他圖干涉 如果有其他圖面會影響到 可能要將需要圓跟矩形抽取出來做連集就OK了
還是很感謝~羨慕能將程式寫的漂亮 熱情
masao_8
masao_8
一般會員
一般會員

文章總數 : 8
年齡 : 29
來自 : 台中
職業 : 製圖
愛好 : 動漫
個性 : 內向
使用年資 : 4年
使用版本 : 2012
經驗值 : 78
威望值 : 0
注冊日期 : 2022-06-03
男 水瓶座 雞

回頂端 向下

想問關於Lisp問題(已解決) Empty 回復: 想問關於Lisp問題(已解決)

發表 由 Atsai 2022-06-12, 21:04

如果會干涉其他圖形,那就在選集先加過濾條件。
(setq ss2 (ssget "f" ptlist))
=>
(setq ss2 (ssget "f" ptlist '((0 . "circle,*polyline"))))
Atsai
Atsai
中級會員
中級會員

文章總數 : 153
年齡 : 47
來自 : 台中
職業 : 工程
愛好 : 看漫畫
個性 : 樂天
使用年資 : 10
使用版本 : 2010
AutoCAD基礎篇等級 : 10星級
積分 : 8
經驗值 : 4946
威望值 : 474
注冊日期 : 2012-04-06
男 金牛座 兔

回頂端 向下

想問關於Lisp問題(已解決) Empty 回復: 想問關於Lisp問題(已解決)

發表 由 masao_8 2022-06-12, 21:45

Atsai 寫到:如果會干涉其他圖形,那就在選集先加過濾條件。
(setq ss2 (ssget "f" ptlist))
=>
(setq ss2 (ssget "f" ptlist '((0 . "circle,*polyline"))))

似乎是選集有圓形的關係 矩形上有接到圓形會跟著做連集
masao_8
masao_8
一般會員
一般會員

文章總數 : 8
年齡 : 29
來自 : 台中
職業 : 製圖
愛好 : 動漫
個性 : 內向
使用年資 : 4年
使用版本 : 2012
經驗值 : 78
威望值 : 0
注冊日期 : 2022-06-03
男 水瓶座 雞

回頂端 向下

回頂端


 
這個論壇的權限:
無法 在這個版面回復文章
想問關於Lisp問題(已解決) Ioaoe110 想問關於Lisp問題(已解決) 2020-310 想問關於Lisp問題(已解決) Oiu15010 想問關於Lisp問題(已解決) 2020-211 想問關於Lisp問題(已解決) Ia15010 想問關於Lisp問題(已解決) Aizyao10
想問關於Lisp問題(已解決) Uos15010 想問關於Lisp問題(已解決) BPl3tjj 想問關於Lisp問題(已解決) Ziao1510 想問關於Lisp問題(已解決) Oo-2-110 想問關於Lisp問題(已解決) Oooo-110 想問關於Lisp問題(已解決) Aizyao11
想問關於Lisp問題(已解決) Uos15011 想問關於Lisp問題(已解決) RQvAhqF 想問關於Lisp問題(已解決) YdKelqY 想問關於Lisp問題(已解決) K410yWG 想問關於Lisp問題(已解決) OhRPPej