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

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

代碼:

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

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

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

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)

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了
還是很感謝~羨慕能將程式寫的漂亮

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

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