谁能用AutoLisp编写这个程式

blue123

楼上的朋友把所有X或Y轴在一条线上尺寸全都标了,就像飞哥说的,如果是很多整齐排列的小孔,这样标注就显得很乱啊.如果在一条线上就只标一个孔啊,它们之间用线连起来会清楚一些

liu22737

,

blue123

楼上的朋友,你还说你是新手,我不相信啊,呵呵

谢谢你啊,你的程式OK.

liu22737

(defun c:dimc(/ ent pt ssg t1 t0 pt1 i)
(if (null (tblsearch "layer" "hidden"))(command "layer" "n" "hidden" "c" "3" "hidden" "l" "hidden" "hidden" ""))
  (setq ent (car (entsel)))
  (setq pt1 (cdr (assoc 10 (entget ent))))
  (setq ssg (ssget "x" (append'((0 . "circle"))(list(cons 40 (cdr (assoc 40 (entget ent)))))) ))
  (setq i 0 t1 '() t0 nil)
  (repeat (sslength ssg)
  (setq t1 (append t1 (list(cdr(assoc 10 (entget(ssname ssg i)))))) i (+ i 1))
  (if (/= (length t1) 1)(setq t1 (vl-sort t1 (function (lambda (p1 p2) (< (car p1) (car p2)))))))
  (if (/= (length t1) 1)(setq t1 (vl-sort t1 (function (lambda (p1 p2) (> (cadr p1) (cadr p2)))))))
  )
  (setq i 0)
  (repeat (sslength ssg)
  (setq pt (nth i t1))
  (if (/= (cadr pt) (cadr pt1))(progn (setq t0 nil)
  (command "_.dimordinate" pt "y" (polar pt pi 15)))
  (progn (if t0 (progn (setq pt1 (cdr(assoc 10 (entget t0)))) (entdel t0) (setq t0 nil)))
  (command "line" pt1 pt "")(setq t0 (entlast))(entmod (subst (cons 8  "hidden") (assoc 8 (entget t0)) (entget t0)))))
  (setq pt1 pt i (+ i 1))
  )
  (if (/= (length t1) 1)(setq t1 (vl-sort t1 (function (lambda (p1 p2) (> (cadr p1) (cadr p2)))))))
  (if (/= (length t1) 1)(setq t1 (vl-sort t1 (function (lambda (p1 p2) (< (car p1) (car p2)))))))
  (setq i 0 t0 nil)
  (repeat (sslength ssg)
  (setq pt (nth i t1))
  (if (/= (car pt) (car pt1))(progn (setq t0 nil)
  (command "_.dimordinate" pt "x" (polar pt (* 0.5 pi) 15)))
  (progn(if t0 (progn (setq pt1 (cdr(assoc 10 (entget t0)))) (entdel t0) (setq t0 nil)))
  (command "line" pt1 pt "")(setq t0 (entlast))(entmod (subst (cons 8  "hidden") (assoc 8 (entget t0)) (entget t0)))))
  (setq pt1 pt  i (+ i 1))
  )
)

HuaiYu

(defun c:t1 (/ en Radius ss tmp Xlst Ylst old_cmdecho old_osmode)
  (vl-load-com)
  (setq *AcadDocument* (vla-get-ActiveDocument (vlax-get-Acad-Object)))
  (setq en (entsel "\nPlease select a circle: "))
  (if en
    (progn
      (vla-startUndoMark *AcadDocument*)
      (setq Radius (vlax-get (vlax-ename->vla-object (car en)) 'Radius))
      (setq ss (ssget "x" (list '(0 . "circle") (cons 40 Radius))))
      (setq tmp  (GetXY ss)
     Xlst (car tmp);得到X列表;
     Ylst (cadr tmp);得到Y列表;
      )
      (setq old_cmdecho (getvar "cmdecho")
     old_osmode (getvar "osmode")
      )
      (setvar "cmdecho" 0)
      (setvar "osmode" 0)

      (DimX Xlst) ;标 X 座标;
      (DimY Ylst) ;标 Y 座标;

      (setvar "cmdecho" old_cmdecho)
      (setvar "osmode" old_osmode)
     
      (vla-endUndoMark *AcadDocument*)
    )
  )
  (prin1)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun DimX (Xlst / i x pt1 pt2)
  (setq i 0)
  (repeat (length XLst)
    (setq x   (car (nth i Xlst))
   pt1 (list x (apply 'min (cdr (nth i Xlst))))
   pt2 (polar (list x (apply 'max (cdr (nth i Xlst)))) (* pi 0.5) (* Radius 2))
    )
    (command ".DIMORDINATE" pt1 pt2)
    (setq i (1+ i))
  )
)
(defun DimY (Ylst / i y pt1 pt2)
  (setq i 0)
  (repeat (length Ylst)
    (setq y   (car (nth i Ylst))
   pt1 (list (apply 'max (cdr (nth i Ylst))) y)
   pt2 (polar (list (apply 'min (cdr (nth i Ylst))) y) pi (* Radius 2))
    )
    (command ".DIMORDINATE" pt1 pt2)
    (setq i (1+ i))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun GetXY (ss / i Xlst Ylst en i vn x y)
  (setq i    0
 Xlst '()
 Ylst '()
  )
  (repeat (sslength ss)
    (setq en (ssname ss i)
   i  (1+ i)
   vn (vlax-ename->vla-object en)
    )
    (setq x (atof (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-center vn)) 0) 2 5)) ;x
   y (atof (rtos (vlax-safearray-get-element (vlax-variant-value (vla-get-center vn)) 1) 2 5)) ;y
    )
    (if (assoc x Xlst) ; X相同﹐Y 不相同;
      (setq Xlst (subst (append (assoc x Xlst) (list y)) (assoc x Xlst) Xlst))
      (setq Xlst (append Xlst (list (list x y))))
    )
    (if (assoc y Ylst) ; Y相同﹐X 不相同;
      (setq Ylst (subst (append (assoc y Ylst) (list x)) (assoc y Ylst) Ylst))
      (setq Ylst (append Ylst (list (list y x))))
    )
  )
  (list Xlst Ylst) ;返回两个表;
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

helison

Good，Thank!

zqw_zhang

各位真实高手，小弟受益匪浅。