[文章]：标注尺寸lisp

wxl1981807

各位大哥，有没有标注尺寸时，标注脚点在一条直线上的lisp程序,

yshf

;请试用以下程序
(defun c:cc()
    (setq cm (getvar "cmdecho") os (getvar "osmode"))
    (setvar "cmdecho" 0)   
    (command "undo" "be")
    (setq p1 (getpoint "\n 尺寸界限第一点 :") i 0)
    (while (progn (cond ((= i 0) (setq p2 (getpoint p1 "\n尺寸界限第二点 :")))
                        (t (setq p2 (getpoint p1 "\n下一点 :")))
                  )
           )
        (setvar "osmode" 0)
        (if (> i 0) (setq p2 (inters pt1 pt2 p2 (polar p2 (+ (angle pt1 pt2) (* 0.5 pi)) 1) nil)))
        (command "_dimaligned" p1 p2 "t" (strcat (rtos (* 0.5 (distance p1 p2)) 2 3) "m"))
        (cond ((= i 0)
               (command  pause)
               (setq p3 (getvar "lastpoint")  pt1 p1 pt2 p2)
              )
              (t (command p3))
        )
        (setq p1 p2 i (1+ i))
        (setvar "osmode" os)
    )
    (command "undo" "e")
    (setvar "cmdecho" cm)(princ)
)

njshf

最好有比例

yshf

;请试用以下程序
(defun c:cc()
(setq cm (getvar "cmdecho") os (getvar "osmode"))
(setvar "cmdecho" 0)
(command "undo" "be")
(setq bl (getreal "\n 请输入比例尺分母<默认为1000>:")
      p1 (getpoint "\n 尺寸界限第一点 :") i 0)
(if (= bl nil) (setq bl 1000))
(setq blc (/ bl 1000.0))
(while (progn (cond ((= i 0) (setq p2 (getpoint p1 "\n尺寸界限第二点 :")))
(t (setq p2 (getpoint p1 "\n下一点 :")))
)
)
(setvar "osmode" 0)
(if (> i 0) (setq p2 (inters pt1 pt2 p2 (polar p2 (+ (angle pt1 pt2) (* 0.5 pi)) 1) nil)))
(command "_dimaligned" p1 p2 "t" (strcat (rtos (* blc (distance p1 p2)) 2 3) "m"))
(cond ((= i 0)
(command pause)
(setq p3 (getvar "lastpoint") pt1 p1 pt2 p2)
)
(t (command p3))
)
(setq p1 p2 i (1+ i))
(setvar "osmode" os)
)
(command "undo" "e")
(setvar "cmdecho" cm)(princ)
)

xiaotang

;;;    此小程序为将坐标写在CAD中

;;-------------------------------------------
(defun zz_err (s)
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (setvar "osmode" os)
  (if dis (setvar "dimzin" dis))
  (setvar "cmdecho" cmd)
  (command "_.UNDO" "_E")
)

;;=============== Main program ============

(defun c:zz (/ cmd os pt x y pt1 x1 y1 xx2 pt2 dis)
  (setq *error* zz_err)
  (setq cmd (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 4271)
   (setq        pt  (getpoint "\n拾取需要标注的点:")
        pt1 (getpoint pt "\n拾取标注线起点:")
  )

  (setq        y  (car pt)
        x  (cadr pt)
        x1 (car pt1)
        y1 (cadr pt1)
        y2 y1
  )
    (if (> x1 y)
    (setq x2  (+ x1 30)
          xx2 (+ x1 0.5)
    )
    (setq x2  (- x1 30)
          xx2 (+ x2 0.5)
    )
  )
  (setvar "osmode" 0)
  (setq pt2 (list x2 y2))
  (command "line" pt pt1 pt2 "")
  (if (null (setq elist (tblsearch "style" "S2")))
    (command "_style" "S2" "S2.ttf" "0.0" "" "0.0" "" "")
  )
  (setvar "TEXTSTYLE" "S2")
  (setq dis (getvar "dimzin"))
  (setvar "dimzin" 1)
  (command "text"
           "ml"
           (list xx2 (+ y1 2.625))
           3.5
           0
           (strcat "X " (rtos x 2 3))
  )
  (command "text"
           "ml"
           (list xx2 (- y1 2.625))
           3.5
           0
           (strcat "Y " (rtos y 2 3))
  )
  (setvar "osmode" os)
  (setvar "dimzin" dis)
  (setvar "cmdecho" cmd)
  (command "_.UNDO" "_E")     
  (princ)
)

这个一个坐标标注的LSP，yshf能帮助加上比例设置吗？

yshf

;; 此小程序为将坐标写在CAD中
;;; 这个一个坐标标注的LSP，yshf能帮助加上比例设置吗？
;;; 现更改如下
;;-------------------------------------------
(defun zz_err (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setvar "osmode" os)
(if dis (setvar "dimzin" dis))
(setvar "cmdecho" cmd)
(command "_.UNDO" "_E")
)

;;=============== Main program ============

(defun c:zz (/ cmd os pt x y pt1 x1 y1 xx2 pt2 dis)
   (setq *error* zz_err)
   (setq cmd (getvar "cmdecho"))
   (setvar "cmdecho" 0)
   (setq os (getvar "osmode"))
   (setvar "osmode" 4271)

   ;猜想你的意思大概是这样的，请注以下三行
   (command "_.undo" "be")
   (setq blx (getreal "\n请输入X轴方向的比例尺分母<默认为1000>:")
         bly (getreal "\n请输入Y轴方向的比例尺分母<默认为1000>:")
         pt  (getpoint "\n拾取需要标注的点:")
         pt1 (getpoint pt "\n拾取标注线起点:")
   )

   ;请注意以下三行
   (if (= blx nil)(setq blx 1000))
   (if (= bly nil)(setq bly 1000))
   (setq blcx (/ blx 1000.0)  blcy (/ bly 1000.0))

   (setq y  (car pt)     x  (cadr pt)
         x1 (car pt1)    y1 (cadr pt1)
         y2 y1
   )
   (if (> x1 y)
       (setq x2 (+ x1 30) xx2 (+ x1 0.5))
       (setq x2 (- x1 30) xx2 (+ x2 0.5))
   )
   (setvar "osmode" 0)
   (setq pt2 (list x2 y2))
   (command "line" pt pt1 pt2 "")
   ;(if (null (setq elist (tblsearch "style" "S2")))
       ;(command "_style" "S2" "S2.ttf" "0.0" "" "0.0" "" "")
   ;)
   ;(setvar "TEXTSTYLE" "S2")
   (setq dis (getvar "dimzin"))
   (setvar "dimzin" 1)

   ;请注意以下两行
   (command "text" "ml" (list xx2 (+ y1 2.625)) 3.5 0 (strcat "X " (rtos (* blcx x) 2 3)))
   (command "text" "ml" (list xx2 (- y1 2.625)) 3.5 0 (strcat "Y " (rtos (* blcy y) 2 3)))

   ;请注意以下四行的顺序
   (command "_.UNDO" "_E")
   (setvar "osmode" os)
   (setvar "dimzin" dis)
   (setvar "cmdecho" cmd)
   (princ)
)

xiaotang

我原先定义的字高是3.5，现在根据图示比例要求，例打印比例是100，需要标注的坐标字高是3.5*100，X、Y方向是同时缩放的，能再更改一下吗，谢谢，另外，使用更改后的程序，标注的文字样式变为了STUNDED，不再是S2了，怎样才能调回去？

yshf

;;; 原来是依打印比例尺要调整标注文字的高度
;;; 现更改如下
;;-------------------------------------------
(defun zz_err (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setvar "osmode" os)
(if dis (setvar "dimzin" dis))
(setvar "cmdecho" cmd)
(command "_.UNDO" "_E")
)

;;=============== Main program ============

(defun c:zz (/ cmd os pt x y pt1 x1 y1 xx2 pt2 dis)
(setq *error* zz_err)
(setq cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 4271)

;请注以下三行
(command "_.undo" "be")
(setq blx (getreal "\n请输入图形的比例尺分母<默认为1000>:")
      bly (getreal "\n请输入打印的比例尺分母<默认为1000>:")
      pt (getpoint "\n拾取需要标注的点:")
      pt1 (getpoint pt "\n拾取标注线起点:")
)

;请注意以下三行
(if (= blx nil)(setq blx 1000.0))
(if (= bly nil)(setq bly 1000.0))
(setq blc (/ bly blx))

(setq y (strcat "Y " (rtos (car pt) 2 3))
      x (strcat "X " (rtos (cadr pt) 2 3))
      x1 (car pt1)  y1 (cadr pt1)
      y2 y1
      dxy (textbox (list (cons 1 x) (cons 40 (* 3.5 blc))))
      dl1 (car (mapcar '- (cadr dxy) (car dxy)))
      dxy (textbox (list (cons 1 y) (cons 40 (* 3.5 blc))))
      dl2 (car (mapcar '- (cadr dxy) (car dxy)))
      ddd dl1
)
(if (> dl2 dl1) (setq dd dl2))
(if (> x1 (car pt))
    (setq x2 (+ x1 ddd 0.5) xx2 (+ x1 0.5))
    (setq x2 (- x1 ddd 0.5) xx2 (+ x2 0.5))
)
(setvar "osmode" 0)
(setq pt2 (list x2 y2))
(command "line" pt pt1 pt2 "")
(if (null (setq elist (tblsearch "style" "S2")))
(command "_style" "S2" "S2.ttf" "0.0" "" "0.0" "" "")
)
(setvar "TEXTSTYLE" "S2")
(setq dis (getvar "dimzin"))
(setvar "dimzin" 1)

;请注意以下两行
(command "text" "ml" (list xx2 (+ y1 (* 2.625 blc))) (* 3.5 blc) 0 x)
(command "text" "ml" (list xx2 (- y1 (* 2.625 blc))) (* 3.5 blc) 0 y)

;请注意以下四行的顺序
(command "_.UNDO" "_E")
(setvar "osmode" os)
(setvar "dimzin" dis)
(setvar "cmdecho" cmd)
(princ)
)

xiaotang

不行的，楼主，坐标标注的文字高度无论怎么调整，还是3.5，没有变化

xshrimp

试试如下
[php]
;;--------------------------
;;DX:连续尺寸对齐标注
;;--------------------------
(defun c:DX()
    (command "orthomode" "1")   
    (setq l1 (getpoint "Offset Position for Beginning of Dimension:

"))
    (setq l2 (getpoint l1 "Location of Dimension Line:

"))
    (command "orthomode" "0")
    (setq l3 (getpoint "Starting intersection to dimension:

"))
    (setq l4 (getpoint l3 "<U>ndo...Next point to dimension:

"))
    (setq b (- (car l1) (car l2)))
    (setq c (- (cadr l1) (cadr l2)))
    (if (= b 0.0)
        (progn
           (command "dim"
                    "_horizontal"
                    (list (car l3) (cadr l1))
                    (list (car l4) (cadr l1))
                    l2
                    ""
           );command
           (while
                 (setq l5 (getpoint l4 "<U>ndo...Next point to dimension:

"))
                 (command "_continue"
                          (list (car l5) (cadr l1))
                          ""
                 );command

                 (setq l4 l5)
           );while
           (command "_horizontal"
                    (list (car l3) (cadr l1))
                    (list (car l4) (cadr l1))
                    (list (car l2)
                          (if (> (cadr l1) (cadr l2))
                              (- (cadr l2) (* (getvar "dimscale") 8))
                              (+ (cadr l2) (* (getvar "dimscale") 8))
                          );if

                    );list
                    ""
                    "e"
          );command
       );progn
    );if
    (if (= c 0.0)
        (progn
           (command "dim"
                    "_vertical"
                    (list (car l1) (cadr l3))
                    (list (car l1) (cadr l4))
                    l2
                    ""
           );command
           (while
                 (setq l5 (getpoint l4 "<U>ndo...Next point to dimension:

"))
                 (command "_continue"
                          (list (car l1) (cadr l5))
                          ""
                 );command

                 (setq l4 l5)
           );while
           (command "_vertical"
                    (list (car l1) (cadr l3))
                    (list (car l1) (cadr l4))
                    (list (if (> (car l1) (car l2))
                              (- (car l2) (* (getvar "dimscale") 8))
                              (+ (car l2) (* (getvar "dimscale") 8))
                          );if
                          (cadr l2)
                    );list
                    ""
                    "e"
          );command
       );progn
    );if
    (if (and (/= c 0.0) (/= b 0.0))
        (progn
          (setq d1 (- (car l1) (car l3)))
          (setq d2 (- (car l1) (car l4)))
          (setq e1 (- (cadr l1) (cadr l3)))
          (setq e2 (- (cadr l1) (cadr l4)))
          (setq x3 (/ (+ (* b b (car  l1)) (* c c (car  l3)) (* b c e1)) (+ (* b b) (* c c))))
          (setq y3 (/ (+ (* b b (cadr l3)) (* c c (cadr l1)) (* b c d1)) (+ (* b b) (* c c))))
          (setq x4 (/ (+ (* b b (car  l1)) (* c c (car  l4)) (* b c e2)) (+ (* b b) (* c c))))
          (setq y4 (/ (+ (* b b (cadr l4)) (* c c (cadr l1)) (* b c d2)) (+ (* b b) (* c c))))
          (command "dim"
                   "aligned"
                   (list x3 y3)
                   (list x4 y4)
                   l2
                   ""
          );command
          (while
               (setq l5 (getpoint l4 "<U>ndo...Next point to dimension:

"))
               (setq d2 (- (car l1) (car l5)))
               (setq e2 (- (cadr l1) (cadr l5)))
               (setq x5 (/ (+ (* b b (car  l1)) (* c c (car  l5)) (* b c e2)) (+ (* b b) (* c c))))
               (setq y5 (/ (+ (* b b (cadr l5)) (* c c (cadr l1)) (* b c d2)) (+ (* b b) (* c c))))
               (command "continue"
                        (list x5 y5)
                        ""
               );command
               (setq l4 l5)
           );while
           (setq alf (atan (/ (- (cadr l2) (cadr l1)) (- (car l2) (car l1)))))
           (if (< (cadr l1) (cadr l2))
           (setq x4 (+ (car l2) (* 8 (getvar "dimscale") (sin alf))))
           (setq x4 (- (car l2) (* 8 (getvar "dimscale") (sin alf)))))
           (if (< (cadr l1) (cadr l2))
           (setq y4 (+ (cadr l2) (* 8 (getvar "dimscale") (cos alf))))
           (setq y4 (- (cadr l2) (* 8 (getvar "dimscale") (cos alf)))))
                    (command "aligned"
                    (list x3 y3)
                    (list x5 y5)
                    (list x4 y4)
                    ""
                    "e"
           );command
         );progn
     );if
);defun
[/php]

wxl1981807

谢谢各位了，有许多函数都没有用过，哪位大哥知道获取图形坐标点的函数,获取标注点坐标的函数

xiaotang

yshf楼主，还有两个问题
一是文字高度没有随比例自动变化
二 是“(setq blx (getreal "\n请输入图形的比例尺分母<默认为1000>:")
bly (getreal "\n请输入打印的比例尺分母<默认为1000>:")”这两行有一个就可以了，直接比如要求输入打印比例为100，则文字高度自动变为3.5*100，谢谢，请帮助调整一下

baobin_yu

结构图大部分中1：100的

xiaotang

当调整后，任意输入打印比例，容易出现下列零长度直线的错误：
命令: ZZ
请输入打印的比例<默认为500>:
拾取需要标注的点:
拾取标注线起点:已在 (-1E+21, -1E+22, 0) 创建零长度直线

yshf

是我把程序中的“(if (> dl2 dl1) (setq ddd dl2))”误写为“(if (> dl2 dl1) (setq dd dl2))”，更正过来后就不出现零长度直线。另外，如两个比例尺分母均取默认值，坐标标注的文字高度肯定不会改变，仍然是3.5。