fedd 发表于 2021-12-26 01:09:25

哪位大侠能出手修改一个代码吗?

风之影大侠的局部放大很好用,但是有两个地方本人非常不喜欢:
1、小圆选好大圆定位的时候显然要取消正交模式,这样便于找一个合适的地方放置局部放大图
2、放大比例为什么还要弄一个对话框呢?简直画蛇添足,明显直接输入一个数这样更方便啊
哪位大侠能修改一下吗?那就完美了
(defun COLORNUMBER (COLOR_STR / COLOR)
(cond
    ((member COLOR_STR (list "BYLAYER" "DALAYER"))(setq COLOR 256))
    ((member COLOR_STR (list "BYBLOCK" "DABLOCCO"))(setq COLOR 0))
    (T (setq COLOR (atoi COLOR_STR)))
)
(eval COLOR)
)

(defun DWGLINE
(DWGLAYER DWGLTYPE DWGCOLOR LIST_POINTS / COUNTER PT_END PT_START)
(setq COUNTER 1)
(while (setq PT_END (nth COUNTER LIST_POINTS))
    (setq PT_START (nth (1- COUNTER) LIST_POINTS))
    (entmake
      (list
      (cons 0 "LINE")
      (cons 8 DWGLAYER)
      (cons 6 DWGLTYPE)
      (cons 62 DWGCOLOR)
      (append (list 10) PT_START)
      (append (list 11) PT_END)
      )
    )
    (setq COUNTER (1+ COUNTER))
)
)

(defun SETPROP (REFERENCE_LIST / COUNTER REFERENCE SET_PROPERTIES PROP_LIST)
(defun SET_PROPERTIES      (REFERENCE / DWGLAYER DWGCOLOR DWGLTYPE DWGLAYER_ALT COL_FLAG FLAG FRZ_FLAG OLD_DWGLTYPE)
    (setq
      DWGLAYER         (nth 1 (nth REFERENCE LIB_LAYERS_LIST))
      DWGLAYER_ALT (nth 2 (nth REFERENCE LIB_LAYERS_LIST))
      DWGCOLOR         (nth 3 (nth REFERENCE LIB_LAYERS_LIST))
      DWGLTYPE         (nth 4 (nth REFERENCE LIB_LAYERS_LIST))
    )
    (if      (not (tblsearch "LTYPE" DWGLTYPE))
      (progn
      (setq OLD_DWGLTYPE DWGLTYPE)
      (setq DWGLTYPE "ByLayer")
      (princ (strcat "\n!!!警告!!!线" OLD_DWGLTYPE "不可能"))
      )
    )
    (if      (not (tblsearch "LAYER" DWGLAYER))
      (setq DWGLAYER DWGLAYER_ALT)
    )
    (if      (tblsearch "LAYER" DWGLAYER)
      (progn
      (setq
          FRZ_FLAG (cdr (assoc 70 (tblsearch "LAYER" DWGLAYER)))
          COL_FLAG (cdr (assoc 62 (tblsearch "LAYER" DWGLAYER)))
      )
      (if (>= FRZ_FLAG 64)(setq FRZ_FLAG (- FRZ_FLAG 64)))
      (if (>= FRZ_FLAG 32)(setq FRZ_FLAG (- FRZ_FLAG 32)))
      (if (>= FRZ_FLAG 16)(setq FRZ_FLAG (- FRZ_FLAG 16)))
      (if (or      (and (= FRZ_FLAG 0) (< COL_FLAG 0))(member FRZ_FLAG (list 1 4 5)))
          (progn
            (princ (strcat "\n层" DWGLAYER "被锁,冻结或关闭"))
            (exit)
          )
      )
      )
    )
    (list DWGLAYER DWGCOLOR DWGLTYPE)
)
(setq COUNTER 0)
(while (< COUNTER (length REFERENCE_LIST))
    (setq
      PROP_LIST
       (append
         PROP_LIST
         (list (set_properties (nth COUNTER REFERENCE_LIST)))
       )
    )
    (setq COUNTER (1+ COUNTER))
)
(setq COUNTER 0)
(while (< COUNTER (length PROP_LIST))
    (if      (not (tblsearch "LAYER" (car (nth COUNTER PROP_LIST))))
      (setq FLAG T)
    )
    (setq COUNTER (1+ COUNTER))
)
(if FLAG
    (progn
      (setq COUNTER 0)
      (setq PROP_LIST nil)
      (while (< COUNTER (length REFERENCE_LIST))
      (setq
          PROP_LIST
         (append
             PROP_LIST
             (list (list (getvar "CLAYER")
                         (colornumber (getvar "CECOLOR"))
                         (getvar "CELTYPE")
                   )
             )
         )
      )
      (setq COUNTER (1+ COUNTER))
      )
    )
)
(car (list PROP_LIST))
)

(defun C:DETAIL
                (/                CENTER_PT01    DWGLAYER
               LAST_ENT      RADIUS02       CENTER_PT02
               DWGLTYPE      MAKE_DETAIL    SCALE
               CENTER_PT01_UCS               PROP_LIST
               OLD_BLIPMODE      SELECT_SOURCEDCL_ID
               ENT_CIRCLE01      OLD_CMDECHO    SS_SOURCE
               DETAIL_ERROR      ENT_CIRCLE02   OLD_ERROR
               SS_TARGET      DETSCALE       ENT_LIST
               OLD_HIGHLIGHT      TRIM_ENT       DWGCOLOR
               ERRMSG                RADIUS01       OLD_OSMODE
               CENTER_PT02_UCS
                )
(setq LIB_LAYERS_LIST
       '(
         ("1" "DRAW" "" 256 "ByLayer")
         ("2" "DRAW" "" 256 "ByLayer")
         ("3" "TEXT" "TEXT" 256 "ByLayer")
         ("4" "HIDDEN" "" 256 "ByLayer")
         ("5" "CENTER" "" 256 "ByLayer")
         ("6" "DIM" "" 256 "ByLayer")
         ("7" "DRAW" "" 151 "ByLayer")
         ("8" "MISC" "" 256 "ByLayer")
       )
)
(defun DETAIL_ERROR (ERRMSG)
    (if      (and (/= ERRMSG "功能取消") (/= ERRMSG "退出"))(princ (strcat "\nDETAIL应用程序错误" ERRMSG "\n")))
    (if      (not (eq LAST_ENT (entlast)))(while (entnext LAST_ENT) (entdel (entlast))))
    (setvar "CMDECHO" OLD_CMDECHO)
    (setvar "BLIPMODE" OLD_BLIPMODE)
    (setvar "OSMODE" OLD_OSMODE)
    (setvar "HIGHLIGHT" OLD_HIGHLIGHT)
    (setq *error* OLD_ERROR)
    (setq
      CENTER_PT01      nil      PROP_LIST      nil      OLD_ERROR      nil      CENTER_PT02      nil
      ENT_CIRCLE01      nil      OLD_HIGHLIGHT      nil      ENT_CIRCLE02      nil      RADIUS01      nil
      DCL_ID                nil      ENT_LIST      nil      RADIUS02      nil      DETAIL_ERROR      nil
      ERRMSG                nil      SCALE                nil      DETSCALE      nil      LAST_ENT      nil
      SELECT_SOURCE      nil      DWGCOLOR      nil      MAKE_DETAIL      nil      SS_SOURCE      nil
      DWGLAYER                nil      OLD_BLIPMODE      nil      SS_TARGET      nil      DWGLTYPE      nil
      OLD_CMDECHO      nil      TRIM_ENT      nil      OLD_OSMODE      nil
    )
    (princ)
)
(setq SCALE (getvar "dimscale"))
(setq OLD_CMDECHO (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(if (> (getvar "UNDOCTL") 3)
    (command "_.UNDO" "_Group")
)
(setq OLD_ERROR *error* *error* DETAIL_ERROR)
(setq OLD_BLIPMODE (getvar "BLIPMODE"))
(setq OLD_OSMODE (getvar "OSMODE"))
(setq OLD_HIGHLIGHT (getvar "HIGHLIGHT"))
(setq LAST_ENT (entlast))
(if LAST_ENT
    (while (entnext LAST_ENT)
      (setq LAST_ENT (entnext LAST_ENT))
    )
)
(setq
    PROP_LIST (setprop (list 7))
    DWGLAYER(nth 0 (car PROP_LIST))
    DWGCOLOR(nth 1 (car PROP_LIST))
    DWGLTYPE(nth 2 (car PROP_LIST))
)
(defun SELECT_SOURCE (/ ANG COUNTER POINTS_LIST SS1 SS2)
    (setq ANG 0.0)
    (while (<= ANG (* 2.0 pi))
      (setq
      POINTS_LIST
         (append POINTS_LIST
               (list (polar CENTER_PT01_UCS ANG RADIUS01))
         )
      )
      (setq ANG (+ ANG (/ pi 12.0)))
    )
    (setq SS1 (ssget "_CP" POINTS_LIST))
    (if      SS1
      (progn
      (setq COUNTER 0)
      (setq SS2 (ssadd))
      (while (setq ENT (ssname SS1 COUNTER))
          (cond
            ((= (cdr (assoc 0 (entget ENT))) "DIMENSION") (eval T))
            ((and
               (= (cdr (assoc 0 (entget ENT))) "INSERT")
               (/=
               (cdr (assoc 41 (entget ENT)))
               (cdr (assoc 42 (entget ENT)))
               (cdr (assoc 43 (entget ENT)))
               )
             )
             (eval T)
            )
            (T (ssadd ENT SS2))
          )
          (setq COUNTER (1+ COUNTER))
      )
      )
    )
    (ssdel ENT_CIRCLE01 SS2)
)

(defun MAKE_DETAIL
         (/ COUNTER NEW_DETSCALE NEXT_ENT PT01 PT02 SS_BLOCKS)
    (initget 1)
    (setq CENTER_PT02_UCS (getpoint CENTER_PT01_UCS "\n目标点"))
    (setq CENTER_PT02 (trans CENTER_PT02_UCS 1 0))
    (setq DCL_ID (load_dialog "detail.dcl"))
    (if      (not (new_dialog "detail" DCL_ID))
      (exit)
    )
    (if      (or (null GLO_DETSCALE) (/= (type GLO_DETSCALE) 'LIST))
      (setq GLO_DETSCALE (list 2.0 1.0))
    )
    (set_tile "scale_01" (rtos (car GLO_DETSCALE)))
    (set_tile "scale_02" (rtos (cadr GLO_DETSCALE)))
    (action_tile
      "scale_01"
      "(setq GLO_DETSCALE (list (atof $value) (cadr GLO_DETSCALE)))(set_tile \"scale_01\" (rtos (car GLO_DETSCALE)))"
    )
    (action_tile
      "scale_02"
      "(setq GLO_DETSCALE (list (car GLO_DETSCALE) (atof $value)))(set_tile \"scale_02\" (rtos (cadr GLO_DETSCALE)))"
    )
    (if      (/= (start_dialog) 1)
      (exit)
    )
    (setq DETSCALE (/ (car GLO_DETSCALE) (cadr GLO_DETSCALE)))
    (setq DETSCALE (* DETSCALE SCALE))
    (setq
      ENT_LIST (subst (cons 8 DWGLAYER) (assoc 8 ENT_LIST) ENT_LIST)
    )
    (setq
      ENT_LIST (subst (cons 6 DWGLTYPE) (assoc 6 ENT_LIST) ENT_LIST)
    )
    (setq
      ENT_LIST (subst (cons 62 DWGCOLOR) (assoc 62 ENT_LIST) ENT_LIST)
    )
    (entmod ENT_LIST)
    (setq RADIUS02 (* RADIUS01 DETSCALE))
    (entmake
      (list
      (cons 0 "CIRCLE")
      (cons 8 DWGLAYER)
      (cons 62 DWGCOLOR)
      (cons 6 DWGLTYPE)
      (append (list 10) CENTER_PT02)
      (cons 40 RADIUS02)
      )
    )
    (setq ENT_CIRCLE02 (entlast))
    (setq NEXT_ENT (entlast))
    (if      (= (cdr (assoc 0 (entget NEXT_ENT))) "POLYLINE")
      (while (/= (cdr (assoc 0 (entget NEXT_ENT))) "SEQEND")
      (setq NEXT_ENT (entnext NEXT_ENT))
      )
    )
    (command "_.COPY" SS_SOURCE      "" CENTER_PT01_UCS CENTER_PT02_UCS)
    (setq SS_TARGET (ssadd))
    (while (setq NEXT_ENT (entnext NEXT_ENT))
      (ssadd NEXT_ENT SS_TARGET)
    )
    (command "_.SCALE" SS_TARGET "" CENTER_PT02_UCS DETSCALE)
    (ssadd ENT_CIRCLE02 SS_TARGET)
    (princ "\n炸块...")
    (setq SS_BLOCKS (ssadd))
    (setq COUNTER 0)
    (while (setq ENT (ssname SS_TARGET COUNTER))
      (if (= (cdr (assoc 0 (entget ENT))) "INSERT")
      (progn
          (ssadd ENT SS_BLOCKS)
          (ssdel ENT SS_TARGET)
      )
      )
      (setq COUNTER (1+ COUNTER))
    )
    (if      (> (sslength SS_BLOCKS) 0)
      (progn
      (setq NEXT_ENT (entlast))
      (command "_.EXPLODE" SS_BLOCKS "")
      (while (setq NEXT_ENT (entnext NEXT_ENT))
          (ssadd NEXT_ENT SS_TARGET)
      )
      )
    )
    (princ "OK.")
    (trim_ent)
    (setq PT01
         (polar CENTER_PT01 (angle CENTER_PT01 CENTER_PT02) RADIUS01)
    )
    (setq PT02
         (polar CENTER_PT02 (angle CENTER_PT02 CENTER_PT01) RADIUS02)
    )
    (dwgline DWGLAYER DWGLTYPE DWGCOLOR (list PT01 PT02))
)
(defun TRIM_ENT (/ ANG      COUNTER                ENT                NEXT_ENT      POINT
                   POINTS_LISTPOINTS_LIST2      SS_INSIDE      SS_OUTSIDE      TRIM_RADIUS
                  )
    (setq ANG 0.0)
    (setq TRIM_RADIUS (* DETSCALE (+ RADIUS01 (* RADIUS01 0.01))))
    (while (< ANG (* 2.0 pi))
      (setq
      POINTS_LIST
         (append POINTS_LIST
               (list (polar CENTER_PT02_UCS ANG TRIM_RADIUS))
         )
      )
      (setq ANG (+ ANG (/ pi 60.0)))
    )
    (setq ANG 0.0)
    (setq TRIM_RADIUS (* DETSCALE (+ RADIUS01 (* RADIUS01 0.1))))
    (while (< ANG (- (* 2.0 pi) 0.1))
      (setq
      POINTS_LIST2
         (append POINTS_LIST2
               (list (polar CENTER_PT02_UCS ANG TRIM_RADIUS))
         )
      )
      (setq ANG (+ ANG (/ pi 24.0)))
    )
    (princ "\n第一剪切圆...")
    (command "_.TRIM" SS_TARGET "" "_Fence")
    (setq COUNTER 0)
    (while (setq POINT (nth COUNTER POINTS_LIST))
      (command POINT)
      (setq COUNTER (1+ COUNTER))
    )
    (command (nth 0 POINTS_LIST) "" "")
    (princ "OK.")
    (princ "\n第二剪切圆...")
    (command "_.TRIM" SS_TARGET "" "_Fence")
    (setq COUNTER 0)
    (while (setq POINT (nth COUNTER POINTS_LIST2))
      (command POINT)
      (setq COUNTER (1+ COUNTER))
    )
    (command (nth 0 POINTS_LIST2) "" "")
    (princ "OK.")
    (princ "\n删除外边的实体...")
    (setq SS_INSIDE (ssget "_WP" POINTS_LIST))
    (setq SS_OUTSIDE (ssadd))
    (setq NEXT_ENT (entnext ENT_CIRCLE02))
    (while NEXT_ENT
      (if (not (ssmemb NEXT_ENT SS_INSIDE))
      (ssadd NEXT_ENT SS_OUTSIDE)
      )
      (setq NEXT_ENT (entnext NEXT_ENT))
    )
    (if      (> (sslength SS_OUTSIDE) 0)
      (command "_.ERASE" SS_OUTSIDE "")
    )
    (princ " OK.")
)
(setq
    CENTER_PT01_UCS
   (getpoint "\n圆的中心点(或按RETURN去选择): ")
)
(if CENTER_PT01_UCS
    (progn
      (setq CENTER_PT01 (trans CENTER_PT01_UCS 1 0))
      (command "_.CIRCLE" CENTER_PT01_UCS)
      (princ
      (strcat "\n直径/<半径> <" (rtos (getvar "CIRCLERAD")) ">: ")
      )
      (while (/= (getvar "CMDNAMES") "")
      (command pause)
      )
      (setq ENT_CIRCLE01 (entlast))
      (setq ENT_LIST (entget ENT_CIRCLE01))
      (setq RADIUS01 (getvar "CIRCLERAD"))
    )
    (progn
      (setq ENT_CIRCLE01 (entsel "\n选择圆:"))
      (if ENT_CIRCLE01
      (progn
          (setq
            ENT_LIST (entget (setq ENT_CIRCLE01 (car ENT_CIRCLE01)))
          )
          (if (= (cdr (assoc 0 ENT_LIST)) "CIRCLE")
            (setq
            CENTER_PT01   (cdr (assoc 10 ENT_LIST))
            CENTER_PT01_UCS (trans CENTER_PT01 0 1)
            RADIUS01            (cdr (assoc 40 ENT_LIST))
            )
            (princ "\n不是圆")
          )
      )
      (princ "\n没有选择")
      )
    )
)
(if RADIUS01
    (progn
      (setvar "BLIPMODE" 0)
      (setvar "OSMODE" 0)
      (setvar "HIGHLIGHT" 0)
      (if (> (sslength (setq SS_SOURCE (select_source))) 0)
      (make_detail)
      (princ "\n圆内没有合理的实体去缩放")
      )
    )
)
(setvar "BLIPMODE" OLD_BLIPMODE)
(setvar "OSMODE" OLD_OSMODE)
(setvar "HIGHLIGHT" OLD_HIGHLIGHT)
(setq *error* OLD_ERROR)
(if (> (getvar "UNDOCTL") 3)
    (command "_.Undo" "_End")
)
(setvar "CMDECHO" OLD_CMDECHO)
(princ)
)

spp_wall 发表于 2021-12-26 21:06:35

免费开源给你用,还说非常不喜欢,画蛇添足的话,合适么?

904772207 发表于 2021-12-27 10:07:43

这话说的怕你是要被围攻了

lxw320 发表于 2021-12-27 12:08:12

真挑剔,不尊重原作者

xj6019 发表于 2021-12-27 12:16:33

哎都不知道说啥好!

masterlong 发表于 2021-12-27 14:39:36

首先
好好学习什么是礼貌什么是尊重
其次
认真学习下置顶贴中的版规
发帖求助你的标题应该是什么样的
第三
如此简单的改动不能自己改?

qmqyqj 发表于 2021-12-31 17:52:47

伸手党,还大言不惭
页: [1]
查看完整版本: 哪位大侠能出手修改一个代码吗?