哪位大侠能出手修改一个代码吗?
风之影大侠的局部放大很好用,但是有两个地方本人非常不喜欢: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)
) 免费开源给你用,还说非常不喜欢,画蛇添足的话,合适么? 这话说的怕你是要被围攻了 真挑剔,不尊重原作者 哎都不知道说啥好! 首先
好好学习什么是礼貌什么是尊重
其次
认真学习下置顶贴中的版规
发帖求助你的标题应该是什么样的
第三
如此简单的改动不能自己改?
伸手党,还大言不惭
页:
[1]