寻找一个自动线性标注和生成侧视图的LISP

siguenguen

各位大师:
               我想找一个能自动线性标注和生成侧视图的LISP。就像下面图片那样。因为拆图在两个命令上反复循环很多次，想节约时间·！

学又学不会，无从下手·！只能求助大师们了·！



这个我把以前的两个类型的lisp合并后的
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:DDF() ;max shape   只能捕捉最大外形线的点，不能捕捉圆的切点
(setq varclayer (getvar "clayer"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(princ "\n Pick the polyline :\n")
        (setq ssentset (ssget))
        (if (/= ssentset nil)
                         (progn
        (setq nent (sslength ssentset))
        (setq i 0)
(repeat        nent
        (setq ssent (entget (ssname ssentset i)))
        (setq numpt (cdr (assoc 90 ssent)))
        (setq tempssent (member (assoc 10 ssent) ssent))
        (setq j1 0)
        (setq listpt '())
        (while (< j1 numpt)
                (setq listpt (append listpt (list (trans (cdr (nth (* j1 4) tempssent)) 0 1))))
                (setq j1 (1+ j1))
        )
        (setq xmin (car (nth 0 listpt)))
        (setq xmax (car (nth 0 listpt)))
        (setq ymin (cadr (nth 0 listpt)))
        (setq ymax (cadr (nth 0 listpt)))
        (setq j2 0)
        (while (< j2 numpt)
                (if        (> xmin (car (nth j2 listpt)))
                        (setq xmin (car (nth j2 listpt)))
                )
                (if        (< xmax (car (nth j2 listpt)))
                        (setq xmax (car (nth j2 listpt)))
                )
                (if        (> ymin (cadr (nth j2 listpt)))
                        (setq ymin (cadr (nth j2 listpt)))
                )
                (if        (< ymax (cadr (nth j2 listpt)))
                        (setq ymax (cadr (nth j2 listpt)))
                )
                (setq j2 (1+ j2))
        );end while
(setq xyfirst (list xmax ymax))
(setq xythird (list xmin ymin))
(command "rectang" xythird xyfirst "")
(setq i (1+ i))                                                       
);end repeat
);end progn
);end if
(setvar "OSMODE" 439)
(setvar "CMDECHO" 1)
(setvar "clayer" varclayer)
(setq pt2 (getpoint "\n起点:"))
   (setq pt3 (getpoint "\n终点:"))
   (setq val (getreal "\n高度:"))
   (SETQ AN (ANGLE PT2 PT3))
   (setq pt4 (polar pt2 (+ AN (/ PI 2)) 20))
   (setq pt5 (polar pt3 (+ AN (/ PI 2)) 20))
   (setq pt6 (polar pt4 (+ AN (/ PI 2)) val))
   (setq pt7 (polar pt5 (+ AN (/ PI 2)) val))
   (command "rectang" pt5 pt6 "")
(command "ERASE" xythird xyfirst "")
   (princ))




   有没有人帮帮我·？自动线性标注，侧视图，兼容2005版·！谢谢

sdls

siguenguen 发表于 2019-5-11 19:48
[em52

;对象长宽标注 明经 ZZXXQQ 2009.1.8

同为打铁匠，老铁你很厉害了！

siguenguen

[em52

;对象长宽标注 明经 ZZXXQQ 2009.1.8
(defun c:1tt(/ dimtx minx0 miny0 maxx0 maxy0 ss end end_data i p1 p2 p3 p4 P5 p6
    keyh p7 p8 p9 p10)
(vl-load-com)
(command "undo" "be")
(setvar "cmdecho" 0)
  (setq keyh nil)
  (setq dimtx (getvar "dimtxt"))
(command "ucs" "w")
(if (and (princ "\nSelect object to dim :") (setq ss (ssget))) (progn
  (setq minx0 1e6 miny0 1e6 maxx0 -1e6 maxy0 -1e6)
  (setq i 0)
  (repeat (sslength ss)
   (setq end (ssname ss i))
   (setq end_data (entget end))
   (Min_Max)
   (setq i(1+ i))
  );end repeat
  (setq p1 (list minx0 miny0)    p2 (list minx0 maxy0)
        p3 (list maxx0 maxy0)    p4 (list maxx0 miny0))
  (autodrawline)
  (command "DIMLINEAR" "non" p1 "non" p2 "non" (polar p2 pi p5))
  (command "DIMLINEAR" "non" p1 "non" p4 "non" (setq p6 (polar p4 (/ pi -2) p5)))
    (princ "\n Please give height ...default<25>：")
    (if (= (car (grread)) 3) (exit))
    (if (= keyh nil) (setq keyh 25))
    (setq p7 (list minx0 (- miny0 p5 (* 8 dimtx))))
    (setq p8 (list maxx0 (- miny0 p5 (* 8 dimtx))))
    (setq p9 (list maxx0 (- (- miny0 p5 (* 8 dimtx)) keyh)))
    (setq p10 (list minx0 (- (- miny0 p5 (* 8 dimtx)) keyh)))
    (vl-cmdf "rectang" p7 p9 "")
  (command "DIMLINEAR" "non" p7 "non" p10 "non" (polar p2 pi p5))
  (command "undo" "e")
))
(princ)
)
;;;子程序，求选集是大外形坐标
(defun Min_Max(/ minx maxx miny maxy)
(vla-getboundingbox(vlax-ename->vla-object end) 'minp 'maxp)
(setq minp (vlax-safearray->list minp)
       maxp (vlax-safearray->list maxp))
(setq minx (car minp)
       maxx (car maxp)
       miny (cadr minp)
       maxy (cadr maxp))
(if (> minx0 minx) (setq minx0 minx))
(if (> miny0 miny) (setq miny0 miny))
(if (< maxx0 maxx) (setq maxx0 maxx))
(if (< maxy0 maxy) (setq maxy0 maxy))
)

;;  defun grread
(defun ZML-GRREAD (LST / test tmp mode val tmp2)
    (setq TEST t)
    (while TEST
(setq TMP  (grread 2)
       MODE (car TMP)
       val  (cadr tmp)
)
(cond ((= mode 2)
        (if (and (setq TMP2 (assoc mode LST))
   (setq tmp2 (cdr tmp2))
   (setq tmp2 (assoc val tmp2))
     )
     (eval (cons 'progn (cdr TMP2)))
     ()
        )
       );row end
       ((setq TMP2 (assoc MODE LST))
        (eval (cons 'progn (cdr TMP2)))
       )
       (t (princ tmp))
)
    )
)

;;;;;;;;;;;;;auto draw line
(defun autodrawline(/ SS lst PT PT0)
     (setq LST
       (list '(5
        (setq pt val)
        ;;
        (redraw)
        (grdraw PT p1 3)
       )
      ;;left press
      '
       (3
        (setq pt val)
(setq p5 (distance PT p1))
        (redraw)
        (setq TEST NIL)
       )
      '(25
        (redraw)
        (setq TEST NIL)
       )
      '(11
        (redraw)
        (setq TEST NIL)
       )
       )
     )
     (ZML-GRREAD lst)
    (princ)
)


美中不足！！！！！

xyp1964

siguenguen

xyp1964 发表于 2017-9-3 23:06

谢谢·！
但不是我想要的·！标注出来像我那种·！

song宋_74729

xyp1964 也是很厉害高手 ,我建议可以请教超级版主 【Gu_xl】

siguenguen

还没有人啊？

mycad

siguenguen

;对象长宽标注 明经 ZZXXQQ 2009.1.8

xjf

我支持一下, 能否大大给个思路