明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 718|回复: 6

[【风之影】] 哪位大侠能出手修改一个代码吗?

[复制链接]
发表于 2021-12-26 01:09 | 显示全部楼层 |阅读模式
风之影大侠的局部放大很好用,但是有两个地方本人非常不喜欢:
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_SOURCE  DCL_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))) "OLYLINE")
      (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_LIST  POINTS_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)
)
发表于 2021-12-26 21:06 | 显示全部楼层
免费开源给你用,还说非常不喜欢,画蛇添足的话,合适么?
发表于 2021-12-27 10:07 | 显示全部楼层
这话说的  怕你是要被围攻了
发表于 2021-12-27 12:08 | 显示全部楼层
真挑剔,不尊重原作者
发表于 2021-12-27 12:16 | 显示全部楼层
哎  都不知道说啥好!
发表于 2021-12-27 14:39 | 显示全部楼层
首先
好好学习什么是礼貌什么是尊重
其次
认真学习下置顶贴中的版规
发帖求助你的标题应该是什么样的
第三
如此简单的改动不能自己改?
发表于 2021-12-31 17:52 | 显示全部楼层
伸手党,还大言不惭
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-3 09:19 , Processed in 0.311274 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表