pBe 发表于 2022-7-6 00:08:31

演示代码。
 

(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)
   )

fixo 发表于 2022-7-6 00:09:56

很酷,伙计
在我的代码存储中抓取。
当做

pBe 发表于 2022-7-6 00:14:14

 
谢谢你,我的朋友
 
希望flyfox能够修改演示代码,并自行解决如何整合发布代码中显示的方法。

flyfox1047 发表于 2022-7-6 00:19:13

 
pBe,谢谢!我会的。

flyfox1047 发表于 2022-7-6 00:20:08

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)
)

lucas3 发表于 2022-7-6 00:23:11

 
飞,非常感谢!我刚刚测试过,不错,但命令栏显示:“放置注释:未知命令”演示。按F1键获取帮助为什么?

lucas3 发表于 2022-7-6 00:28:10

有一点要求:
1、更改文字高度,箭头大小不相应更改
2、文字高度无法记忆,需要每次使用时设置。
我想用“gbeitc.shx”来标注尺寸
pBe、Tharwat、flyfox1047,请帮帮我!

pBe 发表于 2022-7-6 00:31:00

 
“gbeitc.shx”表示维度文本?这取决于你的维度风格lucas
 
默认设置很简单。我会在11号帖子中更新代码[无论如何我都想修改“移动”部分)
 
顺便说一句:想知道Flyfox修改了代码的哪一部分?您是否希望从post#11的原始代码中添加内容?

lucas3 发表于 2022-7-6 00:32:24

 
谢谢pBe,我的意思是创建一个新的文本样式,然后使用这个文本样式维度,但我不能。
箭头大小仍然无法调整。
pBe,代码在#15,dim风格正是我需要的,我希望你和flyfox1047可以帮助我修改代码在#15,非常感谢!
顺便说一句,在#16有一个问题

lucas3 发表于 2022-7-6 00:35:51

等待!我认为箭头的大小应该单独设置等得不耐烦
页: 1 [2]
查看完整版本: 倒角程序,需要hel