将viewport中的内复制到modle中

mmmmmm

不用那么麻烦，使用ExpressTool命令chspace

citykunan

chspace我也用过，是把model中的东西复制到pspace中，这样model的东西就没有了。程序我正在想办法编，应该快好了。

citykunan

(defun C:M_VIEW (/ VCTRX VCTRY LPT RPT ang dis any_point HOLDECHO HOLDOSMODE ss_i
i a len_list first_a first_ent nlist_list first_nlist_list first_nlist_list_backup
first_point first_point BOX WDXF XP W10 W12 W40 W41 W69 SS first_poi
final_list_1 final_list first_one rt lb
) (defun DO_IT (CEN)
(setq VCTRX (car CEN))
(setq VCTRY (cadr CEN))
(setq
LPT (list (- VCTRX (/ W40 2.0)) (- VCTRY (/ W41 2.0)))
)
(setq
RPT (list (+ VCTRX (/ W40 2.0)) (+ VCTRY (/ W41 2.0)))
)
);得出矩形两个角点坐标
(defun Do_any_point (poi)
(setq ang (angle w10 poi))
(setq dis (distance w10 poi))
(setq any_point (polar w12 ang (/ dis xp)))
) ;得到cp框的选择范围。后来想想没有必要。
(setq HOLDECHO (getvar "cmdecho"))
(setq HOLDOSMODE (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "_.undo" "be")
(command "_.PSPACE")
(leo_sc)
;(setq A (car (entsel "\nSelect Viewport: ")))
(setq ss_i (ssget '((0 . "LWPOLYLINE,VIEWPORT"))))
(setq i 0)
(while (< i (sslength ss_i))
(setq a (ssname ss_i i))



;(setq len_list (length nlist_list ))
(setq first_a a)
(setq first_ent (cdr (assoc 0 (entget a))) )
(if (= first_ent "LWPOLYLINE")
(progn
(setq nlist_list (MASSOC 10 (entget a)))
(setq first_nlist_list nlist_list)
(setq first_nlist_list_backup first_nlist_list)
(command "_.pline" (setq first_point (car nlist_list)))
(while (setq nlist_list (cdr nlist_list))
(command (car nlist_list))
);enf while
(command first_point "")
(setq BOX (entlast))
(setq a (cdr (assoc 330 (entget a))));得到附加的viewport组码
);end progn
);end if
(progn
(setq WDXF (entget A))
(setq XP (/ (cdr (assoc 41 WDXF)) (cdr (assoc 45 WDXF))));-------45号码是什么用的？好像是个比例因子，我研究下来发现可以得到viewport的比例
;经多次研究发现41号码除以45号码总能得到viewport的比例
(setq W10 (cdr (assoc 10 WDXF)));viewport视图的中点
(setq W12 (cdr (assoc 12 WDXF)));wcs下的目标点
(setq W40 (cdr (assoc 40 WDXF)));视图的高度


(setq W41 (cdr (assoc 41 WDXF)));视图的宽度
(setq W69 (cdr (assoc 69 WDXF)));app:视口的表示数字
(DO_IT W10)

(if (= first_ent "VIEWPORT")
(progn
(command "_.rectang" LPT RPT)
(setq BOX (entlast))
)
)

(command "zoom" LPT RPT)
(setq W40 (/ W40 XP))
(setq W41 (/ W41 XP))
(command "_.MSPACE")
(setvar "cvport" W69);
(command "_.ucs" "v");
(DO_IT W12);得到相应大小的矩形框。
(if (= first_ent "VIEWPORT")
(setq SS (ssget "c" RPT LPT))
(progn
(while (setq first_poi (car first_nlist_list))
(setq final_list_1 (list (Do_any_point first_poi)))
(setq final_list (append final_list_1 final_list))
(setq first_nlist_list (cdr first_nlist_list))
);end while
(setq SS (ssget "cp" final_list))
);end progn
)
(if SS
(progn
(setq AA (rtos (* (getvar "CDATE") 1E8)));做块名
(command "_.block" AA W12 SS "")
(command "_.oops");undo erase
(command "_.pspace")
(command "_.insert" AA W10 XP "" "")
(if (= first_ent "VIEWPORT")
(command "_.xclip" (entlast) "" "N" "S" BOX)
(progn
(command "_.xclip" (entlast) "" "n" "p" (setq first_one (car first_nlist_list_backup)))
(while (setq first_nlist_list_backup (cdr first_nlist_list_backup))
(command (car first_nlist_list_backup))
);end while
(command first_one "")
);progn
);end if

)
);end if
(command "_.pspace")

(command "_.ERASE" A "")


);end progn

(command "zoom" rt lb)
(setq i (+ i 1))
);end whlie

(setvar "osmode" HOLDOSMODE)
(setvar "cmdecho" HOLDECHO)
(command "_.undo" "e")
(princ)
) ;可以做参考，取得绘图窗口坐标
(defun leo_sc (/ ctr size SCREEN SCALE XSIZE)
(command "_.UCS" "V")
(setq CTR (getvar "VIEWCTR"))
(setq SIZE (getvar "VIEWSIZE"))
(setq SCREEN (getvar "SCREENSIZE"))
(setq SCALE (/ (car SCREEN) (cadr SCREEN)))
(setq XSIZE (* SCALE SIZE))
(setq RT (list (+ (car CTR) (/ XSIZE 2)) (+ (cadr CTR) (/ SIZE 2))))
(setq LB (list (- (car CTR) (/ XSIZE 2)) (- (cadr CTR) (/ SIZE 2))))
;(command "_.line" RT LB "")
;(command "_.UCS" "P")
(princ)
)
;得到同一dxf码的多个值,如 (MASSOC 10 (entget (car (entsel))))，可以得到pline的多个节点
(defun massoc (key alist / x nlist)
(foreach x alist
(if (eq key (car x))
(setq nlist (cons (cdr x) nlist))
)
)
(reverse nlist)
)

(princ)
(prompt "\nType M_VIEW to run")
(princ)
程序基本编完了，但是还有一个问题，好像只能单选，复选后会在成功转换完第一个viewport后出现; error: bad argument type: numberp: nil，不知是什么原因？望版主指教。谢谢。

龙龙仔

當耐心用完我會給你寫一個,但不是現在 (寫好了!但沒有詳細測試及整理)

1.看看它與預期有甚麼不一樣(sslength SS_I)

2.注意:DXF 69 不能為1

3. (and (= FIRST_ENT "LWPOLYLINE")

(= (cdr (assoc 0 (entget (cdr (assoc 330 (entget A))))))

"VIEWPORT"

)

)

4得到cp框的選擇範圍。後來想想沒有必要。

->給你發現了。找它的包圍盒。 8-) "好像連包圍盒也不用" 8-)

5…….

6……..

citykunan

谢谢龙版主，我学到了很多。 好像(sslength SS_I)的值总是0，奇怪。我做了单选的程序用(ENTSEL)去选就没问题了。

龙龙仔

不用理會LWPOLYLINE的頂點(不然有圓弧的LWPOLYLINE你弄得出來嗎?),只要把DXF 330碼去掉,再用ENTMAKE重建LWPOLYLINE即可.

citykunan

版主的提示我有些明白了，明后两日到外地出差，星期一回公司写，班主再给点时间，我应该能写出。谢谢版主。

citykunan

如今可以实现矩形和pline的viewport的复选转换。在编程中我发现一个问题。就是当选择附有viewport的LWPOLYLINE时，哪怕是点选（单选），仍然会显示有两个物体（select object: 2 found)，我不知道为什么，但这会给程序带来麻烦。我猜想可能一个是LWPOLYLINE而另一个是viewport，在多次程序的调试后，我加了一条语句便可成了： (if (and (= FIRST_ENT "LWPOLYLINE")
(= (cdr (assoc 0 (entget (cdr (assoc 330 (entget A)))))) "VIEWPORT")
)
(progn
(setq a (cdr (assoc 330 (entget a))));得到附加的viewport组码
(entmake (vl-remove-if '(lambda (X) (= 330 (car X))) (entget first_a)))
(setq BOX (entlast))
(SETQ i (+ i 1)) ;我加了这句，想跳过LWPOLYLINE后的选择集中的一个物体
);end progn
);end if 其中(SETQ i (+ i 1)) 是为了跳过选择集中的一个东西，结果程序可运行了，但我不知道是为什么，还望高手指点，进一步完善程序。谢谢龙版主的关心。自己通过这个程序学到了不少东西。

龙龙仔

1.這應是Autocad本身的規則吧(對我也是新發現)! 8-)

2.把函數leo_sc刪除吧!不是有do_it函數了嗎?

3.當 (setq ss_i (ssget '((0 . "LWPOLYLINE,VIEWPORT")))),回應all時會出錯的,

a.提示過 w69 > 1

b.對沒有附帶的LWPOLYLINE會出錯

c.……

4.反向操作,從VIEWPORT中也有DXF340碼記錄了VIEWPORT是由某LWPOLYLINE建成

(程序可否利用這點再寫一次,有點要求過多了嗎?)。

PS:[利用這點再寫一次]-----我寫好了!

citykunan

想改进一下，可是又遇到了困难，将程序附上，请高手看看。