侧视图
本帖最后由 ymcui 于 2013-9-25 14:09 编辑如何做到像图一样,可以点选也可以两点定视图尺寸宽度.请高手帮忙做个侧视图的程序.谢谢 本帖最后由 ymcui 于 2013-9-25 14:07 编辑
在五金模具上找的,只是不能自定义侧视图的位置.不能两点定视图的宽度尺寸.达不到像图上的要求.
(defun c:rs()
(setq oce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq OSM (getvar "OSMODE"))
(setvar "OSMODE" 0)
(if (= ro nil)
(progn
(setq qz 25)
(setq oqz qz)
(setq vda 20)
(setq oVDa VDa)
(setq ro 1)
)
)
(setq poi (getpoint "\n请在原图内选取一点"))
(setq msg "请输入高度值:")
(if (/= qz nil) (setq msg (strcat "\n请输入高度值<" (rtos qz) ">:")))
(initget 6)
(setq qz (getreal msg))
(if (= qz nil) (setq qz oqz))
(setq oqz qz)
(setq msg "\n请输入视图间距:")
(if (/= VDa nil) (setq msg (strcat "\n请输入视图间距<" (rtos VDa) ">:")))
(initget 6)
(setq VDa (getreal msg))
(if (= VDa nil) (setq VDa oVDa))
(setq oVDa VDa)
(initget 1)
(COMMAND "BOUNDARY" poi "")
(setq txtnn (ssget "L"))
(setq txtn (ssname txtnn 0))
(setq tdate (entget txtn))
(command "undo" "1")
(setq x (list (cadr (assoc '10 tdate))))
(setq y (list (caddr (assoc '10 tdate))))
(foreach n tdate
(if (= 10 (car n))
(progn
(setq x1 (list (cadr n)))
(setq x (append x x1))
(setq y1 (list (caddr n)))
(setq y (append y y1))
)
)
)
(setq x1(car (vl-sort x '>)))
(setq x2(car (vl-sort x '<)))
(setq y1(car (vl-sort y '>)))
(setq y2(car (vl-sort y '<)))
(setq dx (- x1 x2))
(setq dy (- y1 y2))
(initget 1)
(setq pfa (list x2 (- Y2 VDa)))
(setq pfa1 (mapcar '+ pfa (list dx (- 0 qz))))
(command "ucs" "w")
(command "RECTANG" pfa pfa1)
(initget "Yes No")
(setq cst (getkword "\n是否生成侧视图? (Yes or No)<Yes>"))
(if (= cst nil) (setq cst "Yes"))
(if (= cst "Yes")
(progn
(setq pfa (list (+ x1 VDa) y1 ))
(setq pfa1 (mapcar '- pfa (list (- 0 qz) dy)))
(command "ucs" "w")
(command "RECTANG" pfa pfa1)
)
)
(setvar "OSMODE" OSM)
(setvar "cmdecho" oce)
) 同求 http://bbs.mjtd.com/thread-107683-1-1.html
不是已经有了吗？ 那个程序是非常好,不过我觉复杂了.
就是想简单点，可以点选也可以两点定视图尺寸宽度.
直接绘图，不用对话框形式.
请高手帮忙(defun ayGetSSBoundBox(SS1 / i entName1 PtBox1 minPt maxPt PtLB PtRT)
(setq i 0)
(repeat (sslength SS1)
(setq entName1 (ssname SS1 i))
(vla-GetBoundingBox (vlax-ename->vla-object entName1) 'PtLB 'PtRT)
(setq PtLB (vlax-safearray->list PtLB))
(setq PtRT (vlax-safearray->list PtRT))
(if (= minPt nil)
(setq minPt PtLB)
(progn;else
(if (> (car minPt) (car PtLB)) (setq minPt (List (car PtLB) (cadr minPt))))
(if (> (cadr minPt) (cadr PtLB)) (setq minPt (List (car minPt) (cadr PtLB))))
)
)
(if (= maxPt nil)
(setq maxPt PtRT)
(progn;else
(if (< (car maxPt) (car PtRT)) (setq maxPt (List (car PtRT) (cadr maxPt))))
(if (< (cadr maxPt) (cadr PtRT)) (setq maxPt (List (car maxPt) (cadr PtRT))))
)
)
(setq i (+ i 1))
)
(if (<= (distance minPt maxPt) 0.0)
(setq PtBox nil)
(setq PtBox (list minPt maxPt))
)
)
(DEFUN c:cd()
(setq osm (getvar "osmode"))
(setvar "osmode" 0)
(command "ucs" "w")
(setvar "osmode" 0)
(princ"\n请点选物体:")
(setq SS1 (ssget))
(if (/= SS1 nil)
(progn
(setq Ptbox (ayGetSSBoundBox SS1))
(progn
(setq PtBL (car PtBox))
(setq PtTR (cadr PtBox))
(setq PtBR (list (car PtTR) (cadr PtBL)))
(setq PtTL (list (car PtBL) (cadr PtTR)))
)
(setq x (distance PtTR PtTL))
(recw)
)
(progn
(setvar "osmode" 247)
(SETQ PtTR (GETPOINT "\n请点选第一点:"))
(setq PtTL (GETPOINT "\n请点选第二点:"))
(setq x (distance PtTR PtTL))
(recw)
)
)
)
(DEFUN recw()
(setq point (getpoint "\n请指定点:"))
(setq y (getdist "\n请输入高度:"))
()
(princ)
)
页:
[1]