如何生成图中除弧线以外的元素？

waterchen · 发表于 2015-9-7 11:25

本帖最后由 waterchen 于 2015-9-7 14:31 编辑

改进一下，支持大角度.

(defun c:tt (/
ang
c
d data dimsty dimoff dimtxh dimp1 dimp2 dimp3
ent *error*
flg1 flg2
olderr
m1 m2 mt1 mt2
p1 p2
r
)
(defun *error* (msg)
(princ (strcat "\nError: " msg))
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(setq *error* olderr)
(princ)
)
(defun make_Dim (p1 p2 p3 ang /)
(entmakex
(list
'(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10 p3)
'(11 0. 0. 0.)
'(70 . 32)
'(100 . "AcDbAlignedDimension")
(cons 13 p1)
(cons 14 p2)
(cons 50 ang)
'(100 . "AcDbRotatedDimension")
)
)
)
(defun make_line (p1 p2)
(entmakex (list '(0 . "LINE")
'(100 . "AcDbEntity")
'(100 . "AcDbLine")
(cons 10 p1)
(cons 11 p2)
'(210 0. 0. 1.)
)
)
)
;;;**************************main program**************************;;;
(setq olderr *error*)
(setq p1 (getpoint "\nFirst point:"))
(initget (+ 32 128))
(setq p2 (getpoint p1 "\nSecond point:"))
(if (and
(= 'LIST (type p1))
(= 'LIST (type p2))
(> (distance p1 p2) 250.0)
(setq ent (car (nentselp p1)))
)
(progn
(setq data (entget ent))
(if (equal (cdr (assoc 0 data)) "ARC")
(progn
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq
ang (angle p1 p2)
m1 (polar p1 ang (* 0.5 (distance p1 p2)))
m2 (vlax-curve-getPointAtDist ent
(* 0.5
(vlax-curve-getdistatparam
ent
(vlax-curve-getendparam ent)
)
)
)
c (cdr (assoc 10 data))
r (cdr (assoc 40 data))
mt1 (polar p1 ang 200.0)
dimsty (tblsearch "Dimstyle" (getvar "dimstyle"))
dimoff (* (cdr (assoc 40 dimsty)) (cdr (assoc 147 dimsty)))
dimtxh (* (cdr (assoc 40 dimsty)) (cdr (assoc 140 dimsty)))
dimtxh (+ dimoff (* 3.0 dimtxh))
dimp1 (polar m1 ang dimtxh)
dimp2 (polar mt1 ang dimtxh)
flg1 (car (trans (mapcar '- m2 p1) 0 (mapcar '- p2 p1)))
flg2 (car (trans (mapcar '- c p1) 0 (mapcar '- p2 p1)))
)
(cond
((or
(and (> flg1 0.0) (> flg2 0.0))
(and (< flg1 0.0) (< flg2 0.0))
)
(setq d (+ (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c)))
)
((or
(and (> flg1 0.0) (<= flg2 0.0))
(and (< flg1 0.0) (>= flg2 0.0))
)
(setq d (- (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c)))
)
)
(setq
ang (angle m1 m2)
mt2 (polar mt1 ang d)
dimp3 (polar mt2 ang dimtxh)
)
(make_line p1 p2)
(make_line m1 m2)
(make_line mt1 mt2)
(make_Dim m1 m2 dimp1 (angle m1 m2))
(make_Dim mt1 mt2 dimp2 (angle mt1 mt2))
(make_Dim p1 mt2 dimp3 (angle p1 mt1))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(princ "\nEntity is not an ARC!")
)
)
(princ "\nAt first point can not select ARC entity \nor the distance between 2 points is too short!")
)
(setq *error* olderr)
(princ)
)

(defun c:tt (/ 
       ang 
       c 
       d data dimsty dimoff dimtxh dimp1 dimp2 dimp3 
       ent *error* 
       flg1 flg2 
       olderr 
       m1 m2 mt1 mt2 
       p1 p2 
       r 
       ) 
  (defun *error* (msg) 
    (princ (strcat "\nError: " msg)) 
    (if (= 8 (logand 8 (getvar 'UNDOCTL))) 
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
      ) 
    (setq *error* olderr) 
    (princ) 
    ) 
   
  (defun make_Dim (p1 p2 p3 ang /) 
    (entmakex 
      (list 
  '(0 . "DIMENSION") 
  '(100 . "AcDbEntity") 
  '(100 . "AcDbDimension") 
  (cons 10 p3) 
  '(11 0. 0. 0.) 
  '(70 . 32) 
  '(100 . "AcDbAlignedDimension") 
  (cons 13 p1) 
  (cons 14 p2) 
  (cons 50 ang) 
  '(100 . "AcDbRotatedDimension") 
  ) 
      ) 
    ) 
   
  (defun make_line (p1 p2) 
    (entmakex (list '(0 . "LINE") 
       '(100 . "AcDbEntity") 
       '(100 . "AcDbLine") 
       (cons 10 p1) 
       (cons 11 p2) 
       '(210 0. 0. 1.) 
       ) 
       ) 
    ) 
  ;;;**************************main program**************************;;; 
  (setq olderr *error*) 
  (setq  p1 (getpoint    "\nFirst point:")) 
  (initget (+ 32 128)) 
  (setq  p2 (getpoint p1 "\nSecond point:")) 
  (if (and 
  (= 'LIST (type p1)) 
  (= 'LIST (type p2)) 
  (> (distance p1 p2) 250.0) 
  (setq ent (car (nentselp p1))) 
  ) 
    (progn 
      (setq data (entget ent)) 
       
      (if (equal (cdr (assoc 0 data)) "ARC") 
  (progn 
    (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
    (setq 
      ang    (angle p1 p2) 
      m1     (polar p1 ang (* 0.5 (distance p1 p2))) 
      m2     (vlax-curve-getPointAtDist ent 
         (* 0.5 
      (vlax-curve-getdistatparam 
        ent 
        (vlax-curve-getendparam ent) 
        ) 
      ) 
         ) 
      c      (cdr (assoc 10 data)) 
      r      (cdr (assoc 40 data)) 
      mt1    (polar p1 ang 200.0) 
      dimsty (tblsearch "Dimstyle" (getvar "dimstyle")) 
      dimoff (* (cdr (assoc 40 dimsty)) (cdr (assoc 147 dimsty))) 
      dimtxh (* (cdr (assoc 40 dimsty)) (cdr (assoc 140 dimsty))) 
      dimtxh (+ dimoff (* 3.0 dimtxh)) 
      dimp1  (polar m1  ang dimtxh) 
      dimp2  (polar mt1 ang dimtxh) 
      flg1   (car (trans (mapcar '- m2 p1) 0 (mapcar '- p2 p1))) 
      flg2   (car (trans (mapcar '- c  p1) 0 (mapcar '- p2 p1))) 
      ) 
    
    (cond 
      ((or 
       (and (> flg1 0.0) (> flg2 0.0)) 
       (and (< flg1 0.0) (< flg2 0.0)) 
       ) 
       (setq d (+ (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c))) 
       ) 
       
      ((or 
         (and (> flg1 0.0) (<= flg2 0.0)) 
         (and (< flg1 0.0) (>= flg2 0.0)) 
         ) 
       (setq d (- (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c))) 
       ) 
      ) 
    (setq 
      ang   (angle m1 m2) 
      mt2   (polar mt1 ang d) 
      dimp3 (polar mt2 ang dimtxh) 
      ) 
    (make_line p1  p2) 
    (make_line m1  m2) 
    (make_line mt1 mt2) 
    (make_Dim m1  m2  dimp1 (angle m1  m2)) 
    (make_Dim mt1 mt2 dimp2 (angle mt1 mt2)) 
    (make_Dim p1  mt2 dimp3 (angle p1  mt1)) 
    (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
    ) 
  (princ "\nEntity is not an ARC!") 
  ) 
      ) 
    (princ "\nAt first point can not select ARC entity \nor the distance between 2 points is too short!") 
    ) 
   
  (setq *error* olderr) 
  (princ) 
  )

海贼凌源 · 发表于 2016-2-20 14:55

本帖最后由海贼凌源于 2016-2-20 14:57 编辑

waterchen 发表于 2015-9-5 12:54
楼主看看，是不是想要这样效果的。

谢谢你的回答，抱歉回复的晚了

。不知道为什么代码在我的电脑里使用没有反应，其他的代码也是，但感觉学习到了不少。

waterchen · 发表于 2016-2-22 10:10

海贼凌源发表于 2016-2-20 14:55
谢谢你的回答，抱歉回复的晚了。不知道为什么代码在我的电脑里使用没有反应，其他的代码也是，但感 ...

再试试这个吧，加多了一句 (vl-load-com)。

(defun c:tt (/
ang
c
d data dimsty dimoff dimtxh dimp1 dimp2 dimp3
ent *error*
flg1 flg2
olderr
m1 m2 mt1 mt2
p1 p2
r
)
(vl-load-com)
(defun *error* (msg)
(princ (strcat "\nError: " msg))
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(setq *error* olderr)
(princ)
)
(defun make_Dim (p1 p2 p3 ang /)
(entmakex
(list
'(0 . "DIMENSION")
'(100 . "AcDbEntity")
'(100 . "AcDbDimension")
(cons 10 p3)
'(11 0. 0. 0.)
'(70 . 32)
'(100 . "AcDbAlignedDimension")
(cons 13 p1)
(cons 14 p2)
(cons 50 ang)
'(100 . "AcDbRotatedDimension")
)
)
)
(defun make_line (p1 p2)
(entmakex (list '(0 . "LINE")
'(100 . "AcDbEntity")
'(100 . "AcDbLine")
(cons 10 p1)
(cons 11 p2)
'(210 0. 0. 1.)
)
)
)
;;;**************************main program**************************;;;
(setq olderr *error*)
(setq p1 (getpoint "\nGet First point on arc:"))
(initget (+ 32 128))
(if (listp p1)
(setq p2 (getpoint p1 "\nGet Second point on arc:"))
)
(if (and
(listp p1)
(listp p2)
(> (distance p1 p2) 250.0)
(setq ent (car (nentselp p1)))
)
(progn
(setq data (entget ent))
(if (equal (cdr (assoc 0 data)) "ARC")
(progn
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
(setq
ang (angle p1 p2)
m1 (polar p1 ang (* 0.5 (distance p1 p2)))
m2 (vlax-curve-getPointAtDist ent
(* 0.5
(vlax-curve-getdistatparam
ent
(vlax-curve-getendparam ent)
)
)
)
c (cdr (assoc 10 data))
r (cdr (assoc 40 data))
mt1 (polar p1 ang 200.0)
dimsty (tblsearch "Dimstyle" (getvar "dimstyle"))
dimoff (* (cdr (assoc 40 dimsty)) (cdr (assoc 147 dimsty)))
dimtxh (* (cdr (assoc 40 dimsty)) (cdr (assoc 140 dimsty)))
dimtxh (+ dimoff (* 3.0 dimtxh))
dimp1 (polar m1 ang dimtxh)
dimp2 (polar mt1 ang dimtxh)
flg1 (car (trans (mapcar '- m2 p1) 0 (mapcar '- p2 p1)))
flg2 (car (trans (mapcar '- c p1) 0 (mapcar '- p2 p1)))
)
(cond
((or
(and (> flg1 0.0) (> flg2 0.0))
(and (< flg1 0.0) (< flg2 0.0))
)
(setq d (+ (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c)))
)
((or
(and (> flg1 0.0) (<= flg2 0.0))
(and (< flg1 0.0) (>= flg2 0.0))
)
(setq d (- (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c)))
)
)
(setq
ang (angle m1 m2)
mt2 (polar mt1 ang d)
dimp3 (polar mt2 ang dimtxh)
)
(make_line p1 p2)
(make_line m1 m2)
(make_line mt1 mt2)
(make_Dim m1 m2 dimp1 (angle m1 m2))
(make_Dim mt1 mt2 dimp2 (angle mt1 mt2))
(make_Dim p1 mt2 dimp3 (angle p1 mt1))
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(princ "\nEntity is not an ARC!")
)
)
(princ "\nAt first point can not select ARC entity \nor the distance between 2 points is too short!")
)
(setq *error* olderr)
(princ)
)

(defun c:tt (/ 
       ang 
       c 
       d data dimsty dimoff dimtxh dimp1 dimp2 dimp3 
       ent *error* 
       flg1 flg2 
       olderr 
       m1 m2 mt1 mt2 
       p1 p2 
       r 
       ) 
  (vl-load-com) 
  (defun *error* (msg) 
    (princ (strcat "\nError: " msg)) 
    (if (= 8 (logand 8 (getvar 'UNDOCTL))) 
      (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
      ) 
    (setq *error* olderr) 
    (princ) 
    ) 
   
  (defun make_Dim (p1 p2 p3 ang /) 
    (entmakex 
      (list 
  '(0 . "DIMENSION") 
  '(100 . "AcDbEntity") 
  '(100 . "AcDbDimension") 
  (cons 10 p3) 
  '(11 0. 0. 0.) 
  '(70 . 32) 
  '(100 . "AcDbAlignedDimension") 
  (cons 13 p1) 
  (cons 14 p2) 
  (cons 50 ang) 
  '(100 . "AcDbRotatedDimension") 
  ) 
      ) 
    ) 
   
  (defun make_line (p1 p2) 
    (entmakex (list '(0 . "LINE") 
       '(100 . "AcDbEntity") 
       '(100 . "AcDbLine") 
       (cons 10 p1) 
       (cons 11 p2) 
       '(210 0. 0. 1.) 
       ) 
       ) 
    ) 
  ;;;**************************main program**************************;;; 
  (setq olderr *error*) 
  (setq  p1 (getpoint    "\nGet First point on arc:")) 
  (initget (+ 32 128)) 
  (if (listp p1) 
    (setq  p2 (getpoint p1 "\nGet Second point on arc:")) 
    ) 
  (if (and 
  (listp p1) 
  (listp p2) 
  (> (distance p1 p2) 250.0) 
  (setq ent (car (nentselp p1))) 
  ) 
    (progn 
      (setq data (entget ent)) 
       
      (if (equal (cdr (assoc 0 data)) "ARC") 
  (progn 
    (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
    (setq 
      ang    (angle p1 p2) 
      m1     (polar p1 ang (* 0.5 (distance p1 p2))) 
      m2     (vlax-curve-getPointAtDist ent 
         (* 0.5 
      (vlax-curve-getdistatparam 
        ent 
        (vlax-curve-getendparam ent) 
        ) 
      ) 
         ) 
      c      (cdr (assoc 10 data)) 
      r      (cdr (assoc 40 data)) 
      mt1    (polar p1 ang 200.0) 
      dimsty (tblsearch "Dimstyle" (getvar "dimstyle")) 
      dimoff (* (cdr (assoc 40 dimsty)) (cdr (assoc 147 dimsty))) 
      dimtxh (* (cdr (assoc 40 dimsty)) (cdr (assoc 140 dimsty))) 
      dimtxh (+ dimoff (* 3.0 dimtxh)) 
      dimp1  (polar m1  ang dimtxh) 
      dimp2  (polar mt1 ang dimtxh) 
      flg1   (car (trans (mapcar '- m2 p1) 0 (mapcar '- p2 p1))) 
      flg2   (car (trans (mapcar '- c  p1) 0 (mapcar '- p2 p1))) 
      ) 
    
    (cond 
      ((or 
       (and (> flg1 0.0) (> flg2 0.0)) 
       (and (< flg1 0.0) (< flg2 0.0)) 
       ) 
       (setq d (+ (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c))) 
       ) 
       
      ((or 
         (and (> flg1 0.0) (<= flg2 0.0)) 
         (and (< flg1 0.0) (>= flg2 0.0)) 
         ) 
       (setq d (- (sqrt (- (expt r 2.0) (expt (distance m1 mt1) 2.0))) (distance m1 c))) 
       ) 
      ) 
    (setq 
      ang   (angle m1 m2) 
      mt2   (polar mt1 ang d) 
      dimp3 (polar mt2 ang dimtxh) 
      ) 
    (make_line p1  p2) 
    (make_line m1  m2) 
    (make_line mt1 mt2) 
    (make_Dim m1  m2  dimp1 (angle m1  m2)) 
    (make_Dim mt1 mt2 dimp2 (angle mt1 mt2)) 
    (make_Dim p1  mt2 dimp3 (angle p1  mt1)) 
    (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) 
    ) 
  (princ "\nEntity is not an ARC!") 
  ) 
      ) 
    (princ "\nAt first point can not select ARC entity \nor the distance between 2 points is too short!") 
    ) 
   
  (setq *error* olderr) 
  (princ) 
  )

海贼凌源 · 发表于 2016-2-22 17:26

本帖最后由海贼凌源于 2016-2-22 17:30 编辑

waterchen 发表于 2016-2-22 10:10
再试试这个吧，加多了一句 (vl-load-com)。

谢谢，这回有效果了

，是我要的效果。
请问你用什么制作的动图?

waterchen · 发表于 2016-2-23 09:31

海贼凌源发表于 2016-2-22 17:26
谢谢，这回有效果了，是我要的效果。
请问你用什么制作的动图?

制作这个有很多软件，我用的是LICEcap，网上找下就有了。

海贼凌源 · 发表于 2016-2-24 11:14

waterchen 发表于 2016-2-23 09:31
制作这个有很多软件，我用的是LICEcap，网上找下就有了。

再次感谢

haotaer · 发表于 2016-2-24 17:10

高手出手那纯属娱乐。只是热心帮忙

账号		自动登录	找回密码
密码			注册

[已解答] 如何生成图中除弧线以外的元素？

本帖子中包含更多资源

本帖子中包含更多资源

浏览过的版块