AutoLisp mc对图器.lsp
(defun c:dt (/ dc VC-Apt VC-Bpt bb mouse a aa bb VC-Ap VC-Bp VC-ID VC-A-PZ VC-b-PZ vc-idA vc-idb vc-idx)(YL_begin)
(setvar "OSMODE" 6079)
(if (/= (getvar "tilemode") 1)(setvar "tilemode" 1));返回模型空间
(setq dc (vlax-get-acad-object))
(foreach x '(ActiveDocument viewports count)(setq dc (vlax-get dc x)));;获取视口数量
(cond
((> dc 2);;大于等于3个视口
(if (and
(setq VC-Ap (getpoint "\n指定第1视口的中心点 : "))
(setq VC-Bp (getpoint VC-Ap "\n指定第2视口的中心点 : ")))
(progn
(command "-vports" "si""-vports" "2" "v");;重新创建垂直双视口
(setvar "cvport" (car (car (reverse (vports))))) ;;返回视口
)
(princ "未指定两点。程序退出")))
((= dc 2) ;;于等于2个视口
(PROGN
(setvar "cvport" (car (car (reverse (vports)))))
(setq VC-PZ (getvar 'ViewCtr))
(setvar "cvport" (car (car (reverse (vports)))))
(setq VC-A-PZ (vlax-ldata-get "字典" "VC-A-PZ"))
(setq VC-B-PZ (vlax-ldata-get "字典" "VC-B-PZ"))
(if (or (equal VC-PZ VC-A-PZ 1e-8)
(equal VC-PZ VC-B-PZ 1e-8)
);;判断此双视口是否由本插件生成，以继续执行
(PROGN
(setq VC-Ap (vlax-ldata-get "字典" "PTA"));;读取基点A
(setq VC-Bp (vlax-ldata-get "字典" "PTB"));;读取基点B
)
(PROGN
(setvar "OSMODE" 6079)
(if (and
(setq VC-Ap (getpoint "\n指定第1视口的中心点 : "))
(setq VC-Bp (getpoint VC-Ap "\n指定第2视口的中心点 : ")))
(progn
(setq ZY (car (caddr (car (vports)))))
(command "-vports" "si" "-vports" "2" "v");;重新创建垂直双视口
(if (equal zy 0.5)
(setvar "cvport" (car (car (reverse (vports)))))
)
)
(princ "未指定两点。程序退出")
)
)
)
)
)
((= dc 1) ;;于等于1个视口
(if (and
(setq VC-Ap (getpoint "\n指定第1视口的中心点 : "))
(setq VC-Bp (getpoint VC-Ap "\n指定第2视口的中心点 : ")))
(progn
(command "-vports" "2" "v");;创建垂直双视口
(setvar "cvport" (car (car (reverse (vports))))) ;;返回视口
)
(princ "未指定两点。程序退出"))
)
)
(vlax-ldata-PUt "字典" "PTA" VC-Ap);;保存基点A
(vlax-ldata-PUt "字典" "PTB" VC-Bp);;保存基点B
(setq bb T) ;BB为真，进入循环
(while bb
(setq mouse (grread t 12 0));获取设备按键值
(setq a (car mouse) aa (cadr mouse))
(cond
((and (= a 5) (= nil (equal (getvar 'ViewCtr) (vlax-ldata-get "字典" "VC-A-PZ"))));视口中心坐标发生变
(PROGN
(setq ZYx (car (caddr (car (vports)))))
(IF (equal ZYx 0.5)
(SETQ VC-APT VC-AP VC-BPT VC-BP)
(SETQ VC-APT VC-BP VC-BPT VC-AP)
)
(VCB-VCA VC-Apt VC-Bpt) ;;另一个视口跟随当前视口缩放
)
)
((and (= a 2) (= aa 32));空格暂停对比.
(setq bb nil);结束对比
)
((or (= 25 a) (= 11 a) ;右键
(and (= a 2) (= aa 13));或回车
)
(progn
(setq bb nil);结束对比
(command "-vports" "si" );还原层单视口
)
)
)
)
(YL_end)
)
;钩子
(defun VCB-VCA (VC-Apt VC-Bpt / ptmin ptminn ptmax ptmaxn)
(vlax-ldata-PUt "字典" "VC-A-PZ" (getvar 'ViewCtr))
(setq ptmin (car (viewpnts)) ptmax (cadr (viewpnts))) ;获取当前模型视口对角点
(setq ptminn (polarptmin(angle VC-ApT VC-BpT) (distance VC-ApT VC-BpT)))
(setq ptmaxn (polarptmax(angle VC-ApT VC-BpT) (distance VC-ApT VC-BpT)))
(setvar "cvport" (car (car (reverse (vports))))) ;;切换视口
(zoom-pts ptminnptmaxn)
(vlax-ldata-PUt "字典" "VC-B-PZ" (getvar 'ViewCtr)) ;;临时保存视口中心点坐标
(setvar "cvport" (car (car (reverse (vports))))) ;;返回视口
)
;通过两点来缩放当前视口
(defun zoom-pts ( pt1 pt2 )
(vla-zoomwindow
(vlax-get-acad-object)
(vlax-3d-point pt1)
(vlax-3d-point pt2)
))
;;;117.3 [功能] 返回当前视窗左下角和右上角 坐标
(defun viewpnts (/ A B C D X)
(setq d (getvar "screensize")) ;屏像素
(setq b (* (getvar "viewsize") 0.5) ;viewsize屏竖长
a (* b (/ (car d) (cadr d))) ;屏横长
x (trans (getvar "viewctr") 1 2) ;屏中点viewctr
c (list (- (car x) a) (- (cadr x) b) 0.0)
d (list (+ (car x) a) (+ (cadr x) b) 0.0)
)
(list (trans c 2 1) (trans d 2 1))
)
;;;;===============================必备函数=============================
;;*****************************************************************************
;;功 能：绘图程序的初始化处理，记录当前层名、线型、颜色、捕捉方式、文本样式、文本高度,
;; 控制点标记可见方式、主单位值消零处理方式、命令行回显方式、然后关闭目标捕捉,
;; 设置线形随层、颜色随层、设置命令行不回显、不显示控制点标记、对主单位值后续零作消零处理
;;说 明：和函数YL_end配对使用。
(defun YL_begin ()
(setq oderr *error*) ;;保存原来的*error*
(setq *error* YL_err) ;;将*error*用自己的错误处理函数替代
(setq odltp (getvar "celtype")) ;;记录当前线型设置
(setq odclr (getvar "cecolor")) ;;记录当前颜色设置
(setq odosm (getvar "osmode")) ;;记录当前捕捉方式
(setq odlay (getvar "clayer")) ;;记录当前层
(setq odsty (getvar "textstyle")) ;;记录当前文本样式
(setq odtsz (getvar "textsize")) ;;记录当前文本高度
(setq odbpm (getvar "blipmode")) ;;记录当前控制点标记是否可见
(setq odzin (getvar "dimzin")) ;;记录主单位值消零处理方式
(setq odcmd (getvar "cmdecho")) ;;记录命令行回显方式
(setvar "celtype" "bylayer") ;;设置线形随层
(setvar "cecolor" "bylayer") ;;设置颜色随层
(setvar "cmdecho" 0) ;;设置命令行不回显
(setvar "blipmode" 0) ;;不显示控制点标记
(setvar "dimzin" 8) ;;对主单位值后续零作消零处理,因为DIMZIN 对 AutoLISP rtos 和 angtos 函数执行实数向字符串转换操作有影响。
(setvar "osmode" 0) ;;关闭对象捕捉方式
)
;;*****************************************************************************
;;YL_end
;;功 能：程序结束，恢复程序开始前的设置。
;; 恢复YL_begin设置的系统变量表中的数值。
;;说 明：和函数YL_begin配对使用。
(defun YL_end ()
(setvar "celtype" odltp)
(setvar "cecolor" odclr)
(setvar "osmode" odosm)
(setvar "textstyle" odsty)
(setvar "textsize" odtsz)
(setvar "blipmode" odbpm)
(setvar "dimzin" odzin) ;;恢复主单位值消零处理方式
(setvar "cmdecho" odcmd)
(setq *error* oderr) ;;恢复原来的*error*
(princ)
)
;;*****************************************************************************
;;YL_err
;;功 能：错误处理函数。
(defun YL_err (msg)
(princ (strcat "\n错误:" msg "\n")) ;;打印错误原因
(YL_end) ;;调用函数YL_end恢复程序开始前的设置
(setq *error* oderr) ;;恢复原来的*error*
(princ)
)
页:
[1]