lzg8877 发表于 2019-10-10 11:30:15

求帮忙引线文字，改箭头文，设箭头为1.5 颜色为140.

本帖最后由 lzg8877 于 2019-10-10 17:06 编辑

(defun c:q (/ bz *error* h r p0 teo leo p1 k p)
(command "style" "ctxt" "romand.shx" "" "0.68" "0" "N" "N" "N")
(command "-LAYER" "N" "3" "")
(command "-LAYER" "S" "3" "")
(command "-LAYER" "c" "3" "" "")
(command "-COLOR" "BYLAYER")
(command "-LINETYPE" "S" "BYBlock" "")线型
(command "-LWEIGHT" "BYLAYER")
(setvar "lwdisplay" 0)
(defun *error* (msg) (setvar "osmode" bz) (princ))
(setq bz (getvar "osmode"))
(command "ucs" "w")
(setvar "osmode" 0)
(setq h (getvar "dimscale")
      h (* (if (= h 0) 1 h) (getvar "dimtxt")) r h)
(if (> (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
(vla-put-Height(vla-item (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))) (getvar "textstyle")) 0)
)
(while (setq p0 (getpoint "\n标工作带,请指定插入点:"))
   (setq p0 (trans p0 0 1))
   (command "text" "j" "m" p0 h 0 "ＸＸ")
   (setq teo (entget (entlast)))
   (command "line" p0 (polar p0 (/ pi 4) 0.1) "")
   (setq leo (entget (entlast)))
   (setq p1 (cdr (assoc 10 leo)) k 1)
   (while (/= k 3)
    (setq p (grread T))
    (setq k (car p) p (trans (cadr p) 0 1))
    (setq teo (subst (cons 11 p) (assoc 11 teo) teo))
    (entmod teo)
    (setq p (polar p (angle p p1) r))
    (setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))
    (if (> (distance p p0) 0.0) (entmod leo))
   )
)
   (setvar "osmode" bz)
(princ)
)



start4444 发表于 2019-10-10 11:46:31

直接用引线命令就好了

lzg8877 发表于 2019-10-10 13:34:33

我知，但不一样的，我只要箭头第一段。

start4444 发表于 2019-10-10 16:34:27

那就直接用多段线命令在第一个循环尾部加上画箭头的码就行了

(setq ll (entlast) p2 (cdr (assoc 10 leo)) p3 (polar p0 (angle p0 p2) 1.5))
(command "PLINE" "non" p0 "w" 0 0.6 "non" p3 "w" 0 0 "non" p2 """CHANGE" (entlast) "" "p" "c" 140 "" "ERASE" ll "")

lzg8877 发表于 2019-10-10 17:09:23

不会加试了几次了，水平不够
:'(

start4444 发表于 2019-10-10 17:18:29

(defun c:tt5 (/ bz *error* h r p0 teo leo p1 k p ll)
(command "style" "ctxt" "romand.shx" "" "0.68" "0" "N" "N" "N")
(command "-LAYER" "N" "3" "")
(command "-LAYER" "S" "3" "")
(command "-LAYER" "c" "3" "" "")
(command "-COLOR" "BYLAYER")
(command "-LINETYPE" "S" "BYBlock" "")线型
(command "-LWEIGHT" "BYLAYER")
(setvar "lwdisplay" 0)
(defun *error* (msg) (setvar "osmode" bz) (princ))
(setq bz (getvar "osmode"))
(command "ucs" "w")
(setvar "osmode" 0)
(setq h (getvar "dimscale")
      h (* (if (= h 0) 1 h) (getvar "dimtxt")) r h)
(if (> (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
(vla-put-Height(vla-item (vla-get-TextStyles (vla-get-ActiveDocument (vlax-get-acad-object))) (getvar "textstyle")) 0)
)
(while (setq p0 (getpoint "\n标工作带,请指定插入点:"))
   (setq p0 (trans p0 0 1))
   (command "text" "j" "m" p0 h 0 "ＸＸ")
   (setq teo (entget (entlast)))
   (command "line" p0 (polar p0 (/ pi 4) 0.1) "")
   (setq leo (entget (entlast)))
   (setq p1 (cdr (assoc 10 leo)) k 1)
   (while (/= k 3)
    (setq p (grread T))
    (setq k (car p) p (trans (cadr p) 0 1))
    (setq teo (subst (cons 11 p) (assoc 11 teo) teo))
    (entmod teo)
    (setq p (polar p (angle p p1) r))
    (setq leo (subst (cons 10 p) (assoc 10 (reverse leo)) leo))
    (if (> (distance p p0) 0.0) (entmod leo))
   )

        (setq ll (entlast) p2 (cdr (assoc 10 leo)) p3 (polar p0 (angle p0 p2) 1.5))
        (command "PLINE" "non" p0 "w" 0 0.6 "non" p3 "w" 0 0 "non" p2 """CHANGE" (entlast) "" "p" "c" 140 "" "ERASE" ll "")
       
          )

   (setvar "osmode" bz)
(princ)
)

lzg8877 发表于 2019-10-10 17:18:33

我想问一下，能改动么 还关联么？
页: [1]
查看完整版本: 求帮忙引线文字，改箭头文，设箭头为1.5 颜色为140.