本帖最后由 x_s_s_1 于 2022-12-4 15:45 编辑
也是改几行代码就行,自己可以试试的,我是正好无聊,否者真懒得改
- ;;;ss--选择集
- ;;;pt--定位点
- (defun dimboxp (ss pt / d h lst maxx maxy minx miny n obj pta ptb
- ptc ptl sc x y)
- (setq sc (getvar "dimscale"))
- (setq h (getvar "dimtxt"))
- (setq d (getvar "dimgap"))
- (repeat (setq n (sslength ss))
- (setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
- (vla-getboundingbox obj 'x 'y)
- (setq lst (cons (vlax-safearray->list y)
- (cons (vlax-safearray->list x) lst)
- )
- )
- )
- (setq minx (car (vl-sort (mapcar 'car lst) '<))
- miny (car (vl-sort (mapcar 'cadr lst) '<))
- maxx (car (vl-sort (mapcar 'car lst) '>))
- maxy (car (vl-sort (mapcar 'cadr lst) '>))
- ptl (list (list minx miny)
- (list maxx miny)
- (list maxx maxy)
- (list minx maxy)
- )
- pt (car
- (vl-sort ptl
- '(lambda (x y) (< (distance pt x) (distance pt y)))
- )
- )
- n (1+ (vl-position pt ptl))
- ptl (cons (last ptl) (reverse (cons (car ptl) (reverse ptl))))
- pta (nth (1- n) ptl)
- ptb (nth n ptl)
- ptc (nth (1+ n) ptl)
- )
- (command "dimlinear"
- pta
- ptb
- (polar pta (+ (* -0.5 pi) (angle pta ptb)) (* sc (+ d h h)))
- )
- (command "dimlinear"
- ptb
- ptc
- (polar ptb (+ (* -0.5 pi) (angle ptb ptc)) (* sc (+ d h h)))
- )
- )
- ;;;默认前提,当前标注样式为需要的标注样式
- ;;;默认前提,图层列表中有图层6
- ;;;外轮廓标注,位置随点取
- (defun c:test1 (/ oldla oldos ss)
- (setq oldos (getvar "osmode"))
- (setq oldla (getvar "clayer"))
- (setvar "cmdecho" 0)
- (setvar "osmode" 0)
- (setvar "clayer" "6")
- (prompt "\n选择需标注的门窗:")
- (setq ss (ssget))
- (dimboxp ss (getpoint"\n拾取方向点:"))
- (setvar "osmode" oldos)
- (setvar "clayer" oldla)
- (setvar "cmdecho" 1)
- (princ)
- )
|