鱼与熊掌 发表于 2014-6-1 22:26:09

求完善下代码.(画线并自动标注功能) (源码来自73.)

本帖最后由 鱼与熊掌 于 2014-6-1 22:30 编辑

搞了一天,没什么进展.来求改善.
73哥的代码,画线并标注text文字.
但是有时候会丢失一个东西,比如说点画着画着就发现少了一条线.
丢失了点.文字标出来了.情况是出现在我用点画之后,忽然使用输入20 然后就没了.
http://bbs.mjtd.com/forum.php?mod=image&aid=83260&size=300x300&key=b1e08f8f7801981f&nocache=yes&type=fixnone
少了个点.
除了优化代码之外.
希望可以改个版本,编程自动dli.并且向外偏移3*(标注比例)的值.也就是 (getvar "dimscale")(defun c:ts(/ p q pt)
;(setvar'osmode 16384)
(setqp(getpoint"指定起点"))
(while p
    (if p(progn
   (command "pline" p)
(while(setq q(getpoint p"下一点")pt(mapcar'(lambda(x)(* x 0.5))(mapcar'+ p q)))
    (command q)
    (entmake(list '(0 . "TEXT")(cons 10 pt)(cons 40 1)(cons 1(rtos(distance p q)2 2))
(cons 50 (if(and (<(/ Pi 2)(angle p q))(>(* 1.5 pi)(angle p q)))(angle q p)(angle p q)))
(cons 7 "city")(cons 72 1)(cons 73 1)(cons 40 (* 2 (getvar "dimscale")))(cons 11 pt)))
    (setq p q))
(command "")
(setq p(getpoint"指定起点")))
      (setvar'osmode(-(getvar osmode)16384))))
(princ))

鱼与熊掌 发表于 2014-6-2 17:42:17

香田里浪人 发表于 2014-6-2 14:36 static/image/common/back.gif
鱼与熊掌君,谢谢你答复,

不客气`~~~~~~~~~

香田里浪人 发表于 2014-6-3 17:45:03

;;根据鱼与熊掌君提供的程序,添加两点:1保留小数位数时如果位数不足可以补零2自定义字高
(defun c:tts (/ p q pt en obj)
;(setvar'osmode 16384)
(setvar"dimzin"0);;保留小数位数时如果位数不足可以补零
(setq TextHeight (getdist "\n请输入文字高度:"))
(setq os_bak(getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq p (getpoint "\n指定起点"))
(while p
    (if      p
      (progn
      (command "pline" "_non" p)
      (while (setq q      (getpoint p "下一点")
                     pt      (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))
               )
          (command "_non" q)
          (entmake (list '(0 . "TEXT")
                         (cons 10 pt)
                         (cons 40 1)
                         (cons 1 (rtos (distance p q) 2 2))
                         (cons 50
                               (if (and      (< (/ Pi 2) (angle p q))
                                        (> (* 1.5 pi) (angle p q))
                                 )
                                 (angle q p)
                                 (angle p q)
                               )
                         )
                        (cons 8 "标注")
                         (cons 7 "BG_ST")
                         (cons 62 3)                        
                         (cons 72 1)
                         (cons 73 1)
                         (cons 40 TextHeight)
                         (cons 41 0.7)
                         (cons 11 pt)
                   )
          )
          (setq p q)
      )
      (if (>(getvar 'CMDACTIVE) 0) (command ""))
      (setq p (getpoint "\n指定起点"))
      )
      ;(setvar 'osmode (- (getvar osmode) 16384))
    )
)
(if (>(getvar 'CMDACTIVE) 0) (command ""))
(if os_bak(setvar 'cmdecho os_bak))
(princ)
)

ZJKUSO 发表于 2022-5-19 09:09:42

CAD2006试了,没显示标注

鱼与熊掌 发表于 2014-6-1 23:11:16

(defun c:d` ( / p q pt )
    ;(setvar'osmode 16384)
    (setqp (getpoint"指定起点"))
   
   (while p      
         (if p(progn
         (command "line" p)
      ( while(setq q(getpoint p "下一点"))
             (command q "")
                     
             (setq ang (angle p q))
             (setq pt (polar p (+ ang (* 0.5 pi)) (* 5 (getvar "dimscale"))))
             (command "DIMALIGNED" p q pt)
      
             (command "line" q)

             (setq p q))    ;对换坐标
      ))
         (command "")
         (setq p(getpoint"指定起点"))
      )
   (princ)
)

鱼与熊掌 发表于 2014-6-1 23:20:20

getpoint                     `````````

edata 发表于 2014-6-1 23:32:39

仅供参考,
(defun c:ts (/ p q pt)
;(setvar'osmode 16384)
(setq os_bak(getvar 'cmdecho))
(setvar 'cmdecho 0)
(setq p (getpoint "\n指定起点"))
(while p
    (if        p
      (progn
        (command "pline" "_non" p)
        (while (setq q        (getpoint p "下一点")
                     pt        (mapcar '(lambda (x) (* x 0.5)) (mapcar '+ p q))
             )
          (command "_non" q)
          (entmake
          (list '(0 . "DIMENSION")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbDimension")
                  (cons        10
                        (polar p
                             (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))
                                        (> (* 1.5 pi) (angle p q))
                                   )
                               (angle q p)
                               (angle p q)
                             ))
                             (* 6 (getvar "dimscale"))
                        )
                  )
                  '(70 . 33)
                  '(1 . "")
                  '(100 . "AcDbAlignedDimension")
                  (cons 13 (polar q
                                (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))
                                        (> (* 1.5 pi) (angle p q))
                                   )
                               (angle q p)
                               (angle p q)
                             ))
                             (* 3 (getvar "dimscale"))
                        ))
                  (cons 14 (polar p
                             (+ (* 0.5 pi) (if (and        (< (/ Pi 2) (angle p q))
                                        (> (* 1.5 pi) (angle p q))
                                   )
                               (angle q p)
                               (angle p q)
                             ))
                             (* 3 (getvar "dimscale"))
                        ))
          )
          )
          (entmake (list '(0 . "TEXT")
                       (cons 10 pt)
                       (cons 40 1)
                       (cons 1 (rtos (distance p q) 2 2))
                       (cons 50
                             (if (and        (< (/ Pi 2) (angle p q))
                                        (> (* 1.5 pi) (angle p q))
                                   )
                               (angle q p)
                               (angle p q)
                             )
                       )
                       ;(cons 7 "city")
                       (cons 72 1)
                       (cons 73 1)
                       (cons 40 (* 2 (getvar "dimscale")))
                       (cons 11 pt)
                   )
          )
          (setq p q)
        )
        (if (>(getvar 'CMDACTIVE) 0) (command ""))
        (setq p (getpoint "\n指定起点"))
      )
      ;(setvar 'osmode (- (getvar osmode) 16384))
    )
)
(if (>(getvar 'CMDACTIVE) 0) (command ""))
(if os_bak(setvar 'cmdecho os_bak))
(princ)
)

鱼与熊掌 发表于 2014-6-1 23:32:52

好像捕捉变量关了就好了   擦.关贴

鱼与熊掌 发表于 2014-6-1 23:38:14

(defun c:d` ( / p q pt )
    ;(setvar'osmode 16384)
   (setq o_os (getvar "osmode"))
   (setvar "osmode" 1)
    (setqp (getpoint"指定起点"))
    (setvar "osmode" 0)
   (while p      
         (if p(progn
         (command "line" p)
      ( while(setq q(getpoint p))
             (command q "")
                     
             ;(setq ang (angle p q))
             (setq ang (if(and (<(/ Pi 2)(angle p q))(>(* 1.5 pi)(angle p q)))(angle q p)(angle p q)))
             (setq pt (polar p (+ ang (* 0.5 pi)) (* 5 (getvar "dimscale"))))
             (command "DIMALIGNED" p q pt)
             (setq ang nil)
             (command "line" q)

             (setq p q))    ;对换坐标
      ))
         (command "")
         (setq p(getpoint"指定起点"))
      )
    (setvar "osmode" o_os)
   (princ)
)

鱼与熊掌 发表于 2014-6-1 23:55:07

edata 发表于 2014-6-1 23:32 static/image/common/back.gif
仅供参考,

http://bbs.mjtd.com/forum.php?mod=image&aid=83261&size=300x300&key=180b06b1bebdbb9a&nocache=yes&type=fixnone
标注样式没跟上,要用当前标注样式~
要改哪里

edata 发表于 2014-6-1 23:58:43

不关捕捉会对command函数执行时,造成错误图形或程序执行失败,因此大多数是关了点。
如果command函数调用的命令很少的话,可以采用"non"来临时关闭捕捉,而整个系统的osmode不需要修改。即使程序出错,也不影响使用。
其二,关闭捕捉的方式,建议采用 + - 16384 方式 。这样即使程序出错,按F3或点击osnap也可以直接开启捕捉模式,而不是将所有捕捉类型关闭。可以在论坛搜索到。

鱼与熊掌 发表于 2014-6-2 00:03:57

edata 发表于 2014-6-1 23:58 static/image/common/back.gif
不关捕捉会对command函数执行时,造成错误图形或程序执行失败,因此大多数是关了点。
如果command函数调用 ...

那你上面贴的代码能不能把标注改成当前样式呢, 就是我的全局比例那边已经改了    字应该更大才是标注样式没有更上 距离拉长了`.`

edata 发表于 2014-6-2 00:03:58

鱼与熊掌 发表于 2014-6-1 23:55 static/image/common/back.gif
标注样式没跟上,要用当前标注样式~
要改哪里

当前样式不要用替代。
替代需要更改扩展数据的组码。
或者通过vla方式更改标注数据。
该程序中间禁止任何command函数,切记。
页: [1] 2 3
查看完整版本: 求完善下代码.(画线并自动标注功能) (源码来自73.)