(defun c:demo (/ chfd data p1 p2 gr)
;;; Demo for pBe Jan 2014 ;;;
(defun *error* (msg)
(command "._undo" "_end")
(setvar 'cmdecho cmo)(setvar "dimtad" tad) (setvar "dimgap" gap)(setvar "Dimtxt" dtxt)
) ;_ end_defun
(defun chfd (/ _dxf _para _valid a typ obj p1 p2 intrpt P3 P4)
(Defun _dxf (e dx) (cdr (assoc dx (entget e))))
(defun _valid (e typ / e)
(if (wcmatch (Setq v (_dxf e 0)) typ)
v))
(setq cmo (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "._undo" "_begin")
(if (and (setq a (entsel "\nSelect Chamfered segment: "))
(Setq typ (_valid (setq obj (car a))
"LWPOLYLINE,LINE")))
(if (eq typ "LINE")
(progn
(while (not (And
(setq obj2 (car(entsel"\nSelect another segment: ")))
(setq obj3 (car(entsel"\nAnd another: ")))
(_valid obj2 "LINE")
(_valid obj3 "LINE"))
)
)
(setq intrpt (inters (_dxf obj2 10)
(_dxf obj2 11)
(_dxf obj3 10)
(_dxf obj3 11)
nil))
(Setq p3 (_dxf obj 10) p4 (_dxf obj 11)))
(progn
;;; Kent Cooper ;;;
;;; http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General ;;;
;;; /Find-segments-of-polyline/td-p/4785889 ;;;
(defun ptpar (par)
(reverse
(cdr
(reverse (vlax-curve-getPointAtParam plent par)
)
)
)
)
(setvar "osmode" 0)
(setq
plent(car a) ; the PolyLine ENTity name
verts(cdr (assoc 90 (entget plent)))
; number of VERTiceS
prepar (fix (vlax-curve-getParamAtPoint
plent
(osnap (cadr a) "_nea")
)
)
; PREceding-pick-point vertex's PARameter value
p1 (ptpar (rem (1- (+ prepar verts)) verts))
p4 (ptpar prepar)
p3 (ptpar (rem (1+ prepar) verts))
p2 (ptpar (rem (+ 2 prepar) verts))
) ; setq
(setq intrpt (inters p1 p4 p2 p3 nil))
)
)(princ "\nNull/Invalid selection")
)
(listP3 P4
(if intrpt
(strcat "<<< "
(rtos (distance p3 intrpt) 2 2)
"x"
(rtos (distance p4 intrpt) 2 2)
" >>>"
)
"Invalid data"
)
)
)
(setq tad (Getvar "dimtad") dtxt (getvar "Dimtxt")
gap (getvar "dimgap"))
(if (not height) (setq height 1.00))
(setq height (cond
((getreal
(strcat "\nEnter text height <"
(rtos height 2 2)
">: ")))
(height)))
(if (eq (last (setq data (chfd))) "Invalid data")
(princ "\nNo Data to process")
(progn
(setvar "dimtad" 0)(setvar "dimgap" -1)(setvar "Dimtxt" height)(setvar "cmdecho" 0)
(setq el (entlast) ss2 (ssadd))
(setq p2 (getpoint (setq p1 (mapcar (function (lambda (a b) (/ (+ a b) 2.))) (car data) (cadr data)))
"\n Place annotation: "))
(setvar 'nomutt 1)
(command "leader" "_non" p1 "_non" p2 "" (last data) "" ^c)
(setvar 'nomutt 0)
(While (setq el (entnext el)) (ssadd el ss2))
(setq bridge (entmakex (list (cons 0 "LINE") (cons 10 (car data)) (cons 11 (cadr data)))))
(while (eq 5 (car (setq gr (grread T 15 0))))
(redraw)
(setq p2 (vlax-curve-getClosestPointTo bridge (cadr gr)))
(repeat (setq n (sslength ss2))
(vla-move (vlax-ename->vla-object (ssname ss2 (setq ent (setq n (1- n)))))
(vlax-3d-point p1)(vlax-3d-point p2))
)
(setq p1 p2)
)
(entdel bridge)
)
)
(*error* "")
(princ)
)
很酷,伙计
在我的代码存储中抓取。
当做
谢谢你,我的朋友
希望flyfox能够修改演示代码,并自行解决如何整合发布代码中显示的方法。
pBe,谢谢!我会的。 lucas3代码。
(defun c:demo (/ chfd data p1 p2 gr)
;;;Demo for pBe Jan 2014;;;
(if (not (tblsearch "LAYER" "dim"))
(entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (370 . 18) (2 . "dim") (70 . 0) (62 . 3) (6 . "Continuous")))
(prompt "\nLayer : \"dim\" already exist - setting it to current and proceeding with routine...")
)
(setvar 'clayer "dim")
(vl-load-com)
(defun chfd (/ _dxf _para _valid a typ obj p1 p2 intrpt P3 P4)
(defun _dxf (e dx) (cdr (assoc dx (entget e))))
(defun _valid (e typ / e)
(if (wcmatch (Setq v (_dxf e 0)) typ)
v))
(if (and (setq a (entsel "\nSelect Chamfered segment: "))
(Setq typ (_valid (setq obj (car a))
"LWPOLYLINE,LINE")))
(if (eq typ "LINE")
(progn
(while (not (And
(setq obj2 (car(entsel"\nSelect another segment: ")))
(setq obj3 (car(entsel"\nAnd another: ")))
(_valid obj2 "LINE")
(_valid obj3 "LINE"))
)
)
(setq intrpt (inters (_dxf obj2 10)
(_dxf obj2 11)
(_dxf obj3 10)
(_dxf obj3 11)
nil))
(Setq p3 (_dxf obj 10) p4 (_dxf obj 11)))
(progn
;;; Kent Cooper ;;;
;;; http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General ;;;
;;; /Find-segments-of-polyline/td-p/4785889 ;;;
(defun ptpar (par)
(reverse
(cdr
(reverse (vlax-curve-getPointAtParam plent par)
)
)
)
)
(setvar "osmode" 0)
(setq
plent(car a) ; the PolyLine ENTity name
verts(cdr (assoc 90 (entget plent)))
; number of VERTiceS
prepar (fix (vlax-curve-getParamAtPoint
plent
(osnap (cadr a) "_nea")
)
)
; PREceding-pick-point vertex's PARameter value
p1 (ptpar (rem (1- (+ prepar verts)) verts))
p4 (ptpar prepar)
p3 (ptpar (rem (1+ prepar) verts))
p2 (ptpar (rem (+ 2 prepar) verts))
) ; setq
(setq intrpt (inters p1 p4 p2 p3 nil))
)
)(princ "\nNull/Invalid selection")
)
(listP3 P4
(if intrpt
(progn
(if (eq (rtos (distance p3 intrpt) 2 1) (rtos (distance p4 intrpt) 2 1))
(strcat "C"(rtos (distance p3 intrpt) 2 1))
(strcat
"C"
(rtos (distance p3 intrpt) 2 1)
"x"
(rtos (distance p4 intrpt) 2 1)
)
)
)
"Invalid data"
)
)
)
(defun leader_final_point (p1 p2)
(setq ty (getvar "TEXTSTYLE") kd3 0)
(setq txt_long (* 1.3 (caadr (textbox (list '(0 . "text")(cons 1 (last data))(cons 40 height)(cons 41 0.7)(cons 7 ty))))))
(if (< (car p1) (car p2))
(setq p3 (polar p2 0 txt_long))
(setq p3 (polar p2 (angtof "180") txt_long))
)
)
(setq tad (Getvar "dimtad") dtxt (getvar "Dimtxt")
ech (getvar "cmdecho") gap (getvar "dimgap"))
(setq height 2.5)
(if (setq judge (getreal "Input text height(Default 2.5)"))
(setq height judge)
)
(if (eq (last (setq data (chfd))) "Invalid data")
(princ "\nNo Data to process")
(progn
(setvar "dimtad" 0)(setvar "dimgap" -1)(setvar "Dimtxt" height)(setvar "cmdecho" 0)
(setq el (entlast) ss2 (ssadd))
(princ (entget el))
(setq p2 (getpoint (setq p1 (mapcar (function (lambda (a b) (/ (+ a b) 2.))) (car data) (cadr data)))
"\n Place annotation: "))
(setq p3 (leader_final_point p1 p2) p_modify (list 0 height 0))
(command "leader" "_non" p1 "_non" p2 p3 "" "" "n")
(command "text" "j" "c" (mapcar '(lambda (a b c) (+ (/ (+ a b) 2.) (* c 0.2)))p2 p3 p_modify)height "" (last data) "")
(While (setq el (entnext el)) (ssadd el ss2))
(setq bridge (entmakex (list (cons 0 "LINE") (cons 10 (car data)) (cons 11 (cadr data)))))
(while (eq 5 (car (setq gr (grread T 15 0))))
(redraw)
(command "_move" ss2 "" "_non" p1 "_non" (setq p2 (vlax-curve-getClosestPointTo bridge (cadr gr))))
(setq p1 p2)
)
(entdel bridge)
)
)
(setvar "dimtad" tad) (setvar "dimgap" gap)(setvar "Dimtxt" dtxt)(setvar "cmdecho" ech)
)
飞,非常感谢!我刚刚测试过,不错,但命令栏显示:“放置注释:未知命令”演示。按F1键获取帮助为什么? 有一点要求:
1、更改文字高度,箭头大小不相应更改
2、文字高度无法记忆,需要每次使用时设置。
我想用“gbeitc.shx”来标注尺寸
pBe、Tharwat、flyfox1047,请帮帮我!
“gbeitc.shx”表示维度文本?这取决于你的维度风格lucas
默认设置很简单。我会在11号帖子中更新代码[无论如何我都想修改“移动”部分)
顺便说一句:想知道Flyfox修改了代码的哪一部分?您是否希望从post#11的原始代码中添加内容?
谢谢pBe,我的意思是创建一个新的文本样式,然后使用这个文本样式维度,但我不能。
箭头大小仍然无法调整。
pBe,代码在#15,dim风格正是我需要的,我希望你和flyfox1047可以帮助我修改代码在#15,非常感谢!
顺便说一句,在#16有一个问题 等待!我认为箭头的大小应该单独设置等得不耐烦
页:
1
[2]