日志
侧视图外形
||
(defun getentdxf (ent dxf)
(cond
((= (type ent) 'ename)
(cdr (assoc dxf (entget ent '("*"))))
)
((= (type ent) 'vla-object)
(cdr (assoc dxf (entget (*obj2en* ent) '("*"))))
)
)
)
(defun gpax:getboundingbox (entgrp / entname entpl entplx entply entpr entprx entpry n)
(if (= (type entgrp) 'ename)
(setq entgrp (ssadd entgrp))
)
(repeat (setq n (sslength entgrp))
(setq entname (ssname entgrp (setq n (1- n))))
(vla-getboundingbox (*en2obj* entname) 'entpl 'entpr)
(setq entplx (cons (vlax-safearray-get-element entpl 0) entplx)
entply (cons (vlax-safearray-get-element entpl 1) entply)
entprx (cons (vlax-safearray-get-element entpr 0) entprx)
entpry (cons (vlax-safearray-get-element entpr 1) entpry)
)
)
(list (trans (list (apply 'min entplx) (apply 'min entply)) 0 1) (trans (list (apply 'max entprx) (apply 'max entpry)) 0 1))
)
(defun getmidpoint (p1 p2)
(mapcar '(lambda (x) (/ x 2)) (mapcar '+ p1 p2))
)
(defun *en2obj* (ent)
(cond
((= (type ent) 'ename)
(vlax-ename->vla-object ent)
)
((= (type ent) 'vla-object)
ent
)
)
)
;;; 构造矩形
(defun makerec (pt1 pt2)
(setq pt1 (trans pt1 1 0))
(setq pt2 (trans pt2 1 0))
(entmake
(list
'(0 . "LWPOLYLINE") ; 轻多段线
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 4) ; 四个顶点
'(70 . 1) ; 闭合
(cons 38 (caddr pt1)) ; 高程
(cons 10 (list (car pt1) (cadr pt1))) ; 左下角
(cons 10 (list (car pt2) (cadr pt1))) ; 右下角
(cons 10 (list (car pt2) (cadr pt2))) ; 右上角
(cons 10 (list (car pt1) (cadr pt2))) ; 左上角
(cons 210 '(0 0 1)) ; 法线方向
)
)
(entlast)
)
(defun c:CST ( / ang dirpt entgrp pointlist ptl ptm ptr ptt0 ptt1 ptt2 ptt3 ptt4 xdtt)
(prompt "侧视图外形")
(if (setq entgrp (ssget (list '(-4 . "<not") (cons 0 "xline,ray") '(-4 . "not>"))))
(progn
(setvar "clayer" (getentdxf (ssname entgrp 0) 8))
(setq pointlist (gpax:getboundingbox entgrp))
(setq ptl (car pointlist)
ptr (cadr pointlist)
)
(setq ptm (getmidpoint ptl ptr))
)
(if (setq ptl (getpoint "请指定第一角点:"))
(if (setq ptr (getpoint ptl "请指定第二角点:"))
(setq ptm (getmidpoint ptl ptr))
)
)
)
(if ptm
(while (setq dirpt (getpoint ptm "\n 请指定方向:"))
(if (/= xdt nil)
(setq xdtt xdt)
(setq xdtt 20.0)
)
(setq xdt (getdist (strcat "\n 请指定第一点或输入高度<"
(rtos xdtt 2 2)
">:"
)
)
)
(if (= xdt nil)
(setq xdt xdtt)
)
(setq ang (angle ptm dirpt))
(cond
((or (and (> ang (* 1.75 pi)) (<= ang (* 2 pi)))
(and (>= ang (* 0 pi)) (< ang (* 0.25 pi)))
)
(setq ptt0 (car ptm))
(setq ptt1 (+ ptt0 (distance ptm dirpt)))
(setq ptt2 (+ ptt1 xdt))
(setq ptt3 (list ptt1 (cadr ptl) 0))
(setq ptt4 (list ptt2 (cadr ptr) 0))
)
((and (> ang (* 0.25 pi)) (< ang (* 0.75 pi)))
(setq ptt0 (cadr ptm))
(setq ptt1 (+ ptt0 (distance ptm dirpt)))
(setq ptt2 (+ ptt1 xdt))
(setq ptt3 (list (car ptl) ptt1 0))
(setq ptt4 (list (car ptr) ptt2 0))
)
((and (> ang (* 0.75 pi)) (< ang (* 1.25 pi)))
(setq ptt0 (car ptm))
(setq ptt1 (- ptt0 (distance ptm dirpt)))
(setq ptt2 (- ptt1 xdt))
(setq ptt3 (list ptt1 (cadr ptl) 0))
(setq ptt4 (list ptt2 (cadr ptr) 0))
)
((and (> ang (* 1.25 pi)) (< ang (* 1.75 pi)))
(setq ptt0 (cadr ptm))
(setq ptt1 (- ptt0 (distance ptm dirpt)))
(setq ptt2 (- ptt1 xdt))
(setq ptt3 (list (car ptl) ptt1 0))
(setq ptt4 (list (car ptr) ptt2 0))
)
)
(makerec ptt3 ptt4)
)
)
(princ)
)
