[討論]局部放大功能無法修剪圖塊!

本程式根據葉旭坤局部放大程式改編,對於相交的圖塊無法修剪,請各位高手幫忙修改成可以修剪圖塊的功能,謝謝
<雖然燕秀工具箱裡有很好用的局部放大功能(可以修剪圖塊),可是我不想裝了燕秀卻只用到局部放大的功能,因為我是畫沖壓模具圖的>

代碼:

;;;局部放大===========================================
;;;全部變數JBHD-A(標記字母),JBHD-SC(放大倍數)
(DEFUN C:DJH_220( / CIR_R CLAY CP DATA DATA_A DATA_B DATA_C DATA_D DATA_G DIMCE DIMT HD IN_P JBHD-STRD JBHD-STRIN LAST1 LASTP LASTT MODE OSMO PD SCA_TT STRD STRD1 STRD2 X)
 (setvar "CMDECHO" 0)

;===中斷處理的程式==========
 (defun *error*()
   (princ "錯誤!")
   (setvar "OSMODE" 4151)
   (setvar "AUTOSNAP" 63)
   (princ)
 )
 (defun useerr(s)
   (setq *error* olderr)
   (setvar "CECOLOR" CCLR)
   (setvar "CELTYPE" CLTP)
   (setvar "OSMODE" OSP)
   (setvar "ORTHOMODE" MODE)
   (setvar "AUTOSNAP" 63)
   (setvar "DIMTOFL" DIMT)
   (command "UNDO" "E")
   (princ)
 )
 (setq olderr *error* *error* useerr)
;===========================

 (command "UNDO" "BE")
 (setq
   CCLR (getvar "CECOLOR")
   CLTP (getvar "CELTYPE")
   OSP (getvar "OSMODE");鎖點
   MODE (getvar "ORTHOMODE");正交
   DIMT (getvar "DIMTOFL")
   DIMCE (getvar "DIMCEN")
 )
 (setvar "ORTHOMODE" 0)
 (initget 1)
 (setq CP (getpoint "\n局部放大中心點："))
 (setvar "OSMODE" 0)
 (setvar "DIMCEN" 0)
 (setvar "CELTYPE" "PHANTOM")
 (setvar "CECOLOR" "200")
 (prompt "\n放大範圍：")
 (command "_.CIRCLE" CP PAUSE)
 (setq LAST1 (entlast));放大範圍的圓
 (setq LASTT (cons LAST1 (list (getvar "LASTPOINT"))));(圓.圓心)
 (setq CIR_R (cdr (assoc 40 (entget LAST1))))
 (setq DATA_G (mapcar
  'ANGTOF
  '("0" "15"
   "30" "45"
   "60" "75"
   "90" "105"
   "120" "135"
   "150" "165"
   "180" "195"
   "210" "225"
   "240" "255"
   "270" "285"
   "300" "315"
   "330" "345"
   "0"
  )
       ); end mapcar
 ); end setq
 (setq DATA_A (mapcar
  '(lambda (X)
     (polar CP X CIR_R)
   )
  DATA_G
       )
 )
 (setq DATA (ssget "CP" DATA_A '((-4 . "<NOT") (0 . "TEXT")
      (-4 . "NOT>")
      (-4 . "<NOT")
      (0 . "MTEXT")
      (-4 . "NOT>")
      (-4 . "<NOT")
      (0 . "DIMENSION")
      (-4 . "NOT>")
      (-4 . "<NOT")
      (0 . "HATCH")
      (-4 . "NOT>")
     )
     ); end ssget
 )
 (setq DATA (ssdel LAST1 DATA));去除選集中的圓
 (if (NUMBERP JBHD-A) (setq JBHD-A (1+ JBHD-A)) (setq JBHD-A 65));NUMBERP 判斷 JBHD-A 是否為數字
 (setq JBHD-STRD (chr JBHD-A));將數字內碼轉成英文字65=A
 (setq JBHD-strin (strcat "\n放大標記字母<" JBHD-STRD ">："))
 (setq STRD1 (getstring JBHD-strin))
 (if (= STRD1 "") (setq STRD1 JBHD-STRD))
 (setq STRD2 (strcat STRD1 " 放大"))
 (setq HD (* 1.5 (getvar "DIMTXT")))
 (command "_.DIMTOH" "ON")
 (command "_.DIMTOFL" "off")
 (command "_.DIMDIAMETER" LASTT "M" STRD1 pause);
 (setvar "DIMCEN" DIMCE)
 (prompt "\n放大圖形放置中心點：")
 (setvar "OSMODE" OSP)
 (command "_.COPY" LAST1 "" CP PAUSE)
 (setq
   LASTP (getvar "LASTPOINT")
   LAST1 (entlast)
 )
 (command "_.COPY" DATA "" CP LASTP)
 (setq CIR_R (/ CIR_R (cos (ANGTOF "7.5"))))
 (setq CP LASTP)
 (setq DATA_B (mapcar
   '(LAMBDA (X)
   (polar CP X (+ CIR_R 1))
   )
   DATA_G
     )
 )
 (setq DATA_C DATA_B)
 (setq DATA_D DATA_B)
 (setvar "OSMODE" 0)
 (command "_.TRIM" LAST1 "" "F")
 (while (car DATA_B)
   (setq IN_P (car DATA_B))
   (command IN_P)
   (setq DATA_B (cdr DATA_B))
 ); end while
 (command "" "")
 (command "_.TRIM" LAST1 "" "F")
 (while (car DATA_C)
   (setq IN_P (car DATA_C))
   (command IN_P)
   (setq DATA_C (cdr DATA_C))
 ); end while
 (command "" "")
 (setvar "ATTMODE" 1)
 (initget 6)

 (if (not (NUMBERP JBHD-SC)) (setq JBHD-SC 2))

 (setq Q-SC (strcat "\n放大倍率<" (rtos JBHD-SC 2) ">："))
 (setq JBHD-SC1 (getreal Q-SC))
 (if (not (NUMBERP JBHD-SC1)) (setq JBHD-SC1 JBHD-SC))
 (setq JBHD-SC JBHD-SC1)
 (if (>= JBHD-SC 10)
   (if (= "0" (substr (rtos JBHD-SC 2 2) 4 1))
     (setq sca_tt 0)
     (setq sca_tt 1)
   )
   (if (= "0" (substr (rtos JBHD-SC 2 2) 3 1))
     (setq sca_tt 0)
     (setq sca_tt 1)
   )
 )
 (command "_.SCALE" "CP")
 (while (car DATA_D)
   (setq IN_P (car DATA_D))
   (command IN_P)
   (setq DATA_D (cdr DATA_D))
 );end while
 (command "" "" LASTP JBHD-SC)
 (setq STRD (strcat STRD2 " " (rtos JBHD-SC 2 SCA_TT) ":1"))
 (initget 33)
 (setvar "ORTHOMODE" 1)
 (setq PD (getpoint CP "\n標記字母放置點："))
 (setvar "CELTYPE" "BYLAYER")
 (setvar "CECOLOR" "BYLAYER")
 (command "_.TEXT" "_J" "_M" PD HD 0 STRD)
 (command "_.UNDO" "_E")
 (setvar "CECOLOR" CCLR)
 (setvar "CELTYPE" CLTP)
 (setvar "ORTHOMODE" MODE)
 (setvar "AUTOSNAP" 63)
 (setvar "OSMODE" OSP)
 (setvar "DIMTOFL" DIMT)

;===將*error*回覆成預設功能===
   (setq *error* olderr)
;===========================

 (princ)
)


備用： https://app.box.com/s/b4lsu6sqktwwrjstce5w

再來比較2個局部放大功能的差別

多加了炸開圖塊的附程式.!! 如果原始圖塊圖元在第0層建立..則圖塊炸開後.圖元會回到第0層

代碼:


;;;局部放大===========================================
;;;全部變數JBHD-A(標記字母),JBHD-SC(放大倍數)
(DEFUN C:DJH_220( / CIR_R CLAY CP DATA DATA_A DATA_B DATA_C DATA_D DATA_G DIMCE DIMT HD IN_P JBHD-STRD JBHD-STRIN LAST1 LASTP LASTT MODE OSMO PD SCA_TT STRD STRD1 STRD2 X)
 (setvar "CMDECHO" 0)

;===中斷處理的程式==========
 (defun *error*()
   (princ "錯誤!")
   (setvar "OSMODE" 4151)
   (setvar "AUTOSNAP" 63)
   (princ)
 )
 (defun useerr(s)
   (setq *error* olderr)
   (setvar "CECOLOR" CCLR)
   (setvar "CELTYPE" CLTP)
   (setvar "OSMODE" OSP)
   (setvar "ORTHOMODE" MODE)
   (setvar "AUTOSNAP" 63)
   (setvar "DIMTOFL" DIMT)
   (command "UNDO" "E")
   (princ)
 )
 (setq olderr *error* *error* useerr)
;===========================

 (command "UNDO" "BE")
 (setq
   CCLR (getvar "CECOLOR")
   CLTP (getvar "CELTYPE")
   OSP (getvar "OSMODE");鎖點
   MODE (getvar "ORTHOMODE");正交
   DIMT (getvar "DIMTOFL")
   DIMCE (getvar "DIMCEN")
 )
 (setvar "ORTHOMODE" 0)
 (initget 1)
 (setq CP (getpoint "\n局部放大中心點："))
 (setvar "OSMODE" 0)
 (setvar "DIMCEN" 0)
 (setvar "CELTYPE" "PHANTOM")
 (setvar "CECOLOR" "200")
 (prompt "\n放大範圍：")
 (command "_.CIRCLE" CP PAUSE)
 (setq LAST1 (entlast));放大範圍的圓
 (setq LASTT (cons LAST1 (list (getvar "LASTPOINT"))));(圓.圓心)
 (setq CIR_R (cdr (assoc 40 (entget LAST1))))
 (setq DATA_G (mapcar
  'ANGTOF
  '("0" "15"
   "30" "45"
   "60" "75"
   "90" "105"
   "120" "135"
   "150" "165"
   "180" "195"
   "210" "225"
   "240" "255"
   "270" "285"
   "300" "315"
   "330" "345"
   "0"
  )
       ); end mapcar
 ); end setq
 (setq DATA_A (mapcar
  '(lambda (X)
     (polar CP X CIR_R)
   )
  DATA_G
       )
 )
 
 (setq DATA (ssget "CP" DATA_A '((-4 . "<NOT") (0 . "TEXT")
      (-4 . "NOT>")
      (-4 . "<NOT")
      (0 . "MTEXT")
      (-4 . "NOT>")
      (-4 . "<NOT")
      (0 . "DIMENSION")
      (-4 . "NOT>")
      (-4 . "<NOT")
      (0 . "HATCH")
      (-4 . "NOT>")
     )
     ); end ssget
 )
 (setq DATA (ssdel LAST1 DATA));去除選集中的圓
 (if (NUMBERP JBHD-A) (setq JBHD-A (1+ JBHD-A)) (setq JBHD-A 65));NUMBERP 判斷 JBHD-A 是否為數字
 (setq JBHD-STRD (chr JBHD-A));將數字內碼轉成英文字65=A
 (setq JBHD-strin (strcat "\n放大標記字母<" JBHD-STRD ">："))
 (setq STRD1 (getstring JBHD-strin))
 (if (= STRD1 "") (setq STRD1 JBHD-STRD))
 (setq STRD2 (strcat STRD1 " 放大"))
 (setq HD (* 1.5 (getvar "DIMTXT")))
 (command "_.DIMTOH" "ON")
 (command "_.DIMTOFL" "off")
 (command "_.DIMDIAMETER" LASTT "M" STRD1 pause);
 (setvar "DIMCEN" DIMCE)
 (prompt "\n放大圖形放置中心點：")
 (setvar "OSMODE" OSP)
 (command "_.COPY" LAST1 "" CP PAUSE)
 (setq
   LASTP (getvar "LASTPOINT")
   LAST1 (entlast)
 )
  
 (SETQ SN1 LAST1) ;取得複制前的最後一個圖元.
  
 (command "_.COPY" DATA "" CP LASTP)
  
 (exp_insert) ;<-炸破副程式
  
 (setq CIR_R (/ CIR_R (cos (ANGTOF "7.5"))))
 (setq CP LASTP)
 (setq DATA_B (mapcar
   '(LAMBDA (X)
   (polar CP X (+ CIR_R 1))
   )
   DATA_G
     )
 )
 (setq DATA_C DATA_B)
 (setq DATA_D DATA_B)
 (setvar "OSMODE" 0)
 (command "_.TRIM" LAST1 "" "F")
 (while (car DATA_B)
   (setq IN_P (car DATA_B))
   (command IN_P)
   (setq DATA_B (cdr DATA_B))
 ); end while
 (command "" "")
 (command "_.TRIM" LAST1 "" "F")
 (while (car DATA_C)
   (setq IN_P (car DATA_C))
   (command IN_P)
   (setq DATA_C (cdr DATA_C))
 ); end while
 (command "" "")
 (setvar "ATTMODE" 1)
 (initget 6)

 (if (not (NUMBERP JBHD-SC)) (setq JBHD-SC 2))

 (setq Q-SC (strcat "\n放大倍率<" (rtos JBHD-SC 2) ">："))
 (setq JBHD-SC1 (getreal Q-SC))
 (if (not (NUMBERP JBHD-SC1)) (setq JBHD-SC1 JBHD-SC))
 (setq JBHD-SC JBHD-SC1)
 (if (>= JBHD-SC 10)
   (if (= "0" (substr (rtos JBHD-SC 2 2) 4 1))
     (setq sca_tt 0)
     (setq sca_tt 1)
   )
   (if (= "0" (substr (rtos JBHD-SC 2 2) 3 1))
     (setq sca_tt 0)
     (setq sca_tt 1)
   )
 )
 (command "_.SCALE" "CP")
 (while (car DATA_D)
   (setq IN_P (car DATA_D))
   (command IN_P)
   (setq DATA_D (cdr DATA_D))
 );end while
 (command "" "" LASTP JBHD-SC)
 (setq STRD (strcat STRD2 " " (rtos JBHD-SC 2 SCA_TT) ":1"))
 (initget 33)
 (setvar "ORTHOMODE" 1)
 (setq PD (getpoint CP "\n標記字母放置點："))
 (setvar "CELTYPE" "BYLAYER")
 (setvar "CECOLOR" "BYLAYER")
 (command "_.TEXT" "_J" "_M" PD HD 0 STRD)
 (command "_.UNDO" "_E")
 (setvar "CECOLOR" CCLR)
 (setvar "CELTYPE" CLTP)
 (setvar "ORTHOMODE" MODE)
 (setvar "AUTOSNAP" 63)
 (setvar "OSMODE" OSP)
 (setvar "DIMTOFL" DIMT)

;===將*error*回覆成預設功能===
   (setq *error* olderr)
;===========================

 (princ)
)
;;--------------------------------------------------------------
(defun exp_insert(/ en-name)
  (setq en (entnext sn1))
  (while (/= en nil)
  (setq en-name (dxfa 0 en))
  (if (= en-name "INSERT")(command "explode" en))
  (setq en (entnext en))
  )
)



備用： https://app.box.com/s/hjro2toua0z0l6nyngcm

謝謝shenhung的改版，太好了，明天去公司試試，我又學到一招了

為什麼我下載不了啊~樓主大人~

li60830 寫到:為什麼我下載不了啊~樓主大人~

已經重新上傳LISP附件囉～


但是程式執行是失敗的～
局部放大中心點：
執行完就結束了...

Tiger&蘋果爸 寫到:

li60830 寫到:為什麼我下載不了啊~樓主大人~

已經重新上傳LISP附件囉～


但是程式執行是失敗的～
局部放大中心點：
執行完就結束了...

感謝無私的分享
相當完整的工具有些小瑕疵,建議稍做修正

代碼:


(setvar "CELTYPE" "PHANTOM");不是每張圖都有的線形
 (command "linetype" "l" "PHANTOM" "" "" "s" "PHANTOM" "");改為載入線形避免錯誤


stephen-peng 寫到:
感謝無私的分享
相當完整的工具有些小瑕疵,建議稍做修正

代碼:


(setvar "CELTYPE" "PHANTOM");不是每張圖都有的線形
 (command "linetype" "l" "PHANTOM" "" "" "s" "PHANTOM" "");改為載入線形避免錯誤


原來是線型啊！
還沒有空看程式說，謝謝 stephen-peng大 熱心除錯！

代碼:


;;--------------------------------------------------------------
(defun exp_insert(/ en-name)
  (setq en (entnext sn1))
  (while (/= en nil)
     ;(setq en-name (dxfa 0 en))
          (setq en-name (cdr (assoc 0 (entget en))));因為少了dxfa函數，所以改成下面這一列就好了。
     (if (= en-name "INSERT")(command "explode" en))
     (setq en (entnext en))
  )
)


除了上面的線型問題，還要再改一下這一列，就可以了。

Atsai 寫到:

代碼:


;;--------------------------------------------------------------
(defun exp_insert(/ en-name)
  (setq en (entnext sn1))
  (while (/= en nil)
  ;(setq en-name (dxfa 0 en))
          (setq en-name (cdr (assoc 0 (entget en))));因為少了dxfa函數，所以改成下面這一列就好了。
  (if (= en-name "INSERT")(command "explode" en))
  (setq en (entnext en))
  )
)


除了上面的線型問題，還要再改一下這一列，就可以了。

多謝Atsai熱心指導。
真是感恩喔～