CAD截图做大样

masterlong · 发表于 2017-11-25 14:01:34

本帖最后由 masterlong 于 2017-11-28 19:54 编辑

要是缺什么子函数的告诉我

复制代码

;先使用vrec绘制多个矩形
;再使用vjts选择矩形

;;常用变量
(setq
  *ent2obj*    vlax-Ename->Vla-Object
  *obj2ent*    vlax-vla-object->ename
  *aboutp* vlax-get-Property
  ;;常用VLA对象、集合
  *acadobject* (vlax-get-acad-object)
  *acad*    (vlax-get-acad-object)
  *acaddoc* (vla-get-ActiveDocument *acad*)
  *doc*    (vla-get-ActiveDocument *acad*)
  *alldocs* (vla-get-Documents *acad*)
  *MSpace* (vla-get-modelSpace *doc*)
  *PSpace* (vla-get-paperSpace *doc*)
  *BLKS* (vla-get-Blocks *doc*)
  *BLOCKS* (vla-get-Blocks *doc*)
  *LAYS* (vla-get-Layers *doc*)
  *LAYERS* (vla-get-Layers *doc*)
  *Linetypes* (vla-get-Linetypes *doc*)
  *TextStyles*  (vla-get-TextStyles *doc*)
  *groups* (vla-get-groups *doc*)
  *DIMS* (vla-get-DimStyles *doc*)
  *Layouts* (vla-get-Layouts *doc*)
  *Viewports* (vla-get-Viewports *doc*)
  *Views* (vla-get-Views *doc*)
  *DICS* (vla-get-Dictionaries *doc*)
  ;;常用的几个外部接口对象
  *FSO* (vlax-get-or-create-object "Scripting.FileSystemObject")
  *WSH* (vlax-get-or-create-object "wscript.shell")
  *SHELL* (vlax-get-or-create-object "Shell.Application")
  *SCR* (vlax-get-or-create-object "ScriptControl")
  *WBEM*  (vlax-get-or-create-object "WbemScripting.SWbemLocator")
)

;;建立下一程序所需要的文件夹、图层，并绘制矩形
(defun c:vrec()
(vl-mkdir "c:\\qgy_temp")
(vl-mkdir "c:\\qgy_temp\\布局转模型")
(setvar "ctab" "model")
(command "layer"  "m" "z__其它" "c" "240" "" "m" "zzz___图框内框线" "c" "30" "" "P" "N" "" "")
(command "rectang" pause pause)
)

;;选择指定图层中的矩形，分别指定每个矩形的大样放置位置，借用高版CAD的布局转模型命令，在模型中生成大样。（速度会有点慢，但不是死机）【需要express工具支持】
(defun c:vjts()
(setq oldosmode (getvar "osmode"))
(setvar "osmode" 0)
(if (and
(setvar "ctab" "model")
(setq recss (ssget '((0 . "LWPOLYLINE")(8 . "zzz___图框内框线")(90 . 4)(70 . 1))))
(setq pppooo (car (ssbox recss)))
  )
  (progn
      (command "undo" "g")
(setq oflist '())
(foreach x (setq reclist (ss2list recss))
   (zooment x 8)
   (setq xbox (entbox x))
   (setq p1 (car xbox)
      p2 (cadr xbox)
      p12 (list (car p1) (cadr p2))
   )
   (setq ss (ssadd x))
   (setq p3 (acet-ss-drag-move ss p1 T 0)) ;;【如果没有安装express工具】将此句改为 (setq p3 (getpoint p1 "\n指定空白处1点 : "))
   (if (or
      (and (< (car p1) (car p3)) (> (cadr p1) (cadr p3)))
      (and (> (car p1) (car p3)) (< (cadr p1) (cadr p3)))
      )
   (command "line" "non" p1 "non" p3 "" "change" (entlast) "" "p" "la" "z__其它" "co" 240 "lt" "byl" "")
   (command "line" "non" p1 "non" p3 "" "move" (entlast) "" "non" p1 "non" p12 "change" (entlast) "" "p" "la" "z__其它" "co" 240 "lt" "byl" "")
   )

   (setq oflist (cons (list x p3) oflist))
)
(setq oflist (reverse oflist))
(setq 时间 (getvar "cdate"))
(setq 时间 (rtos 时间 2 6))
(setq 标记时间 (strcat (substr 时间 1 4) "年" (substr 时间 5 2) "月" (substr 时间 7 2) "日" (substr 时间 10 2) "时" (substr 时间 12 2) "分") )
(setq 组合块名 (strcat "临时布局___" 标记时间 (substr 时间 14)))
(setq thevpname 组合块名)
(setq vpp_vplot (vla-add *Layouts* thevpname))
(setvar "ctab" thevpname)
(foreach xpppp oflist
   (setq x (car xpppp)
      p3 (cadr xpppp)
   )
   (setq box (entbox x))
   (setq p1 (car box)
      p2 (cadr box)
   )
   (setq vvvp1 p3
      vvvp2 (ptwy (ptwy p3 (- (car p2) (car p1)) 0) 0 (- (cadr p2)(cadr p1)))
   )
   (command "_mview" "non" vvvp1 "non" vvvp2)
   (setq vdfx69 (cdr (assoc 69 (entget (entlast)))))
   (command "PSPACE" "zoom" "w" "non" vvvp1 "non" vvvp2)
   (command "_mspace")
   (setvar "cvport" vdfx69)
   (command "zoom" "w" "non" p1 "non" p2)
   (command "_mview" "l" "on" "l" "")
   (command "PSPACE")
)
(command "PSPACE" "zoom" "e")
(command "EXPORTLAYOUT" (strcat "c:\\qgy_temp\\布局转模型\\" thevpname ".dwg"))
(setvar "ctab" "model")
(vlax-invoke-method vpp_vplot 'Delete)
(command "insert" (strcat "c:\\qgy_temp\\布局转模型\\" thevpname ".dwg") "non" '(0 0) 1 1 0)
(command "undo" "e")
  )
)
(princ)
)

;999以指定图元缩放窗口
(defun zooment( ent sc / box x midpo ) ;;(setq paper (cdr (assoc 410 (entget ent)))) (~~ paper) (setvar "ctab" paper)
(setq box (entbox ent))
   ;;(setq box (mapcar 'u2w box))
(setq midpo (getmidpo box))
(setq box (mapcar '(lambda (x) (p0_sc_p1 midpo x sc)) box))
(vla-zoomwindow *acad* (vlax-3d-point (car box)) (vlax-3d-point (cadr box)))
box
)
;;单个物体的最小（正交）包围框---------------------------------这个程序在遇到无法显示的图元时，还是会出错的，比如形。天正图元会不会也不支持，未测试
(defun entbox ( ent / ll ur )
(vla-getboundingbox (*ent2obj* ent) 'll 'ur)
(mapcar 'vlax-safearray->list (list ll ur))
)
;;选择集转为图元列表
(defun ss2list ( ss / n i elist )
(setq n (if (= (type ss) 'Pickset) (sslength ss) 0)
i n
elist '()
)
(repeat n
  (setq elist (cons (ssname ss (setq i (1- i))) elist))
)
)
;;选择集的最小（正交）包围框
(defun ssbox( ss / ll ur aa bb )
(if (= (type ss) 'PICKSET)
  (setq ss (ss2list ss))
)
(foreach x ss
  (vla-getboundingbox (*ent2obj* x) 'll 'ur)
  (setq aa (cons (vlax-safearray->list ll) aa)
bb (cons (vlax-safearray->list ur) bb)
  )
)
(mapcar '(lambda(a b) (apply 'mapcar (cons a b)))
  '(min max)
  (list aa bb)
)
)
;;ptwy  点坐标位移
(defun ptwy( pt x y )
(polar (polar pt 0 x) (setq d_090  (* 0.5 pi)) y)
)

masterlong · 发表于 2017-11-30 09:35:19

与选择集有关的函数
在执行前都应该先检验参数是否选择集
楼上的函数可以这样改
(if (= (type ss) 'Pickset) (mapcar 'cadr (ssnamex ss)))

再见熊猫衣服 · 发表于 2018-12-28 23:11:04

___
命令:VJTS
选择对象：找到 1 个

选择对象： undo
当前设置: 自动 = 开，控制 = 全部，合并 = 是，图层 = 是
输入要放弃的操作数目或 [自动(A)/控制(C)/开始(BE)/结束(E)/标记(M)/后退(B)] <1>:g
指定空白处1点 :
指定空白处1点 : line
指定第一点: non
指定下一点或 [角度(A)/长度(L)/放弃(U)]: non
指定下一点或 [角度(A)/长度(L)/放弃(U)]:
move
选择对象：找到 1 个

选择对象：

指定基点或 [位移(D)] <位移>: non指定第二个点或 <使用第一个点作为位移>: nonchange
选择对象：找到 1 个

选择对象：
指定修改点或 [特性(P)]: p
输入要更改的特性 [颜色(C)/标高(E)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/透明度(TR)/材质(M)/注释性(A)]:
la
输入新图层名 <zzz___图框内框线>: z__其它
输入要更改的特性 [颜色(C)/标高(E)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/透明度(TR)/材质(M)/注释性(A)]:
co
新颜色 [真彩色(T)/配色系统(CO)] <ByLayer>:
输入要更改的特性 [颜色(C)/标高(E)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/透明度(TR)/材质(M)/注释性(A)]:
lt
输入新线型名 <CONTINUOUS>: byl
线型“byl”未找到。请用 LINETYPE 命令来加载。
输入要更改的特性 [颜色(C)/标高(E)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/透明度(TR)/材质(M)/注释性(A)]:
; 错误:
函数被取消

输入要更改的特性 [颜色(C)/标高(E)/图层(LA)/线型(LT)/线型比例(S)/线宽(LW)/厚度(T)/透明度(TR)/材质(M)/注释性(A)]:
*取消*

_____
还是报错，楼主在不在，帮帮忙啊。。

masterlong · 发表于 2017-11-30 09:39:28

本帖最后由 masterlong 于 2017-11-30 09:42 编辑

;;求点对中点
(defun getmidpo( pts / P1 P2 X Y )
      (setq p1 (car pts) p2 (cadr pts))
      (if (= (length p1) (length p2))
            nil
            (setq p1 (list (car p1) (cadr p1))
                              p2 (list (car p2) (cadr p2))
            )
      )
      (mapcar '(lambda (X Y) (/ (+ X Y) 2.0)) P1 P2)
)

“/”在使用时
要注意除数是整数还是小数
另外p1、p2格式不同是容易被忽视的

USER2128 · 发表于 2017-11-27 11:55:22

感谢大师分享程序!

xinxirong · 发表于 2017-11-27 20:14:07

缺这个函数，其它的能靠名字猜：
ptwy

masterlong · 发表于 2017-11-28 01:04:29

;;ptwy 点坐标位移
(defun ptwy( pt x y )
(polar (polar pt 0 x) d_090 y)
)

masterlong · 发表于 2017-11-28 01:05:00

(setq d_090 (* 0.5 pi))

xudi1234 · 发表于 2017-11-28 12:42:52

no function definition: *ENT2OBJ*

出现这个，啥问题？

小男人漏水 · 发表于 2017-11-28 13:20:33

学习一下。谢谢

xinxirong · 发表于 2017-11-28 15:51:32

EXPORTLAYOUT不支持天正建筑图，有办法不用这个命令吗？

xinxirong · 发表于 2017-11-28 20:13:53

不喜欢做成块，G版的局部放大做成xclip也是无奈之举啊。

masterlong · 发表于 2017-11-28 21:17:03

不是建筑专业对天正不熟悉
个人习惯要求建筑提资转t3
需要画大样的时候
一般都是用这个程序来截图
其实高版cad的剪切功能比低版功能要强
直接框外剪切也可以
无非是操作麻烦一点而已

账号		自动登录	找回密码
密码			注册

[源码] CAD截图做大样

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

本帖子中包含更多资源

点评