用图元创建多线时，如何设置线宽？

ynhh

请教大师，用图元创好多线时如何加入线宽的设置？41和42，或43等几个位置的设置均无法成功。不知是什么原因，请大师指点。
谢谢

以下是用下载的程序改的，但线宽设置有问题无法应用？

(defun AAA  (pts Xk);

(if (entmake (append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
      
'(43 . XK);此处设置无法正常运转

(cons 90 (length pts))
         )
         (mapcar '(lambda (x) (cons 10 (trans x 1 0))) pts)
         '((210 0. 0. 1.))
      
        )
      )
    (entlast)
  )
)

springwillow

'(43 . XK)改成(cons 43 xk)

ynhh

感谢大师的热心指点.
你说的很有道理

能不能再请教你一个以下程序想改为动态的多线更新问题?
感谢你的热心指点

(defun zcx()
    (setvar "osmode" 0)
    ;(setq p2 (getpoint P1 "\n-->请指定文字位置:")
  (setq p2 (polar p1 0 10)
        a1 (car p1 )
        c1 (car p2)
        vx (* (- (strlen TXT) 0.2) (* ht 0.75))     
        le vx
    )
    (if (< c1 a1)
    (setq pp (polar p2 pi le)
   p3 (polar pp (/ pi 2) zj)
    )
  (setq pp (polar p2 0 le)
p3 (polar p2 (/ pi 2) zj)
  ))
  (command "line" p1 p2 "")
  (setq en1 (entlast))
  (command "line" p2 pp "")
  (setq en2 (entlast))
  
;;;请教大师:我想到两根直线合并为一根带线宽的多线,但不知如何实现动态更新?有此功能吗?如有请教方法，感谢你。
(setq XK 0.3);设置线宽
(setq pts (list p1 p2 PP));将多个点合成一个点表
(HDX pts XK);画带线宽的多线
(setq en20 (entlast))
  
;;;  (command "text" P3 ht 0 TXT)
(command "TEXT" "J" "ML" P3 ht "0" TXT);----画样式写入文字
  (setq en3 (entlast));entlast 返回最后一个未删除的主图元名。
  (setq ent1 (entget en1); entget 此函数将由数据库中取出 ename 的图元, 同时返回一表
ent2 (entget en2)
ent3 (entget en3))
  (setq le1 (caadr (textbox ent3))); textbox 这个函数将计算一个文字图元并返回包围文字的交互坐标框。
  (setq le (* 1.2 le1)
jl (* 0.1 le1))
;;|;;
  (while (= (car (setq mouse (grread t 0 0))) 5)
      (setq pt (cadr mouse))
      
      (if (>= (car pt)(car p1))
(progn
;以下句子可自行简写
   (setq pt (trans pt 1 0))
   (setq ent1 (subst (cons 11 pt)(assoc 11 ent1) ent1))
; subst 此函数将在 list 寻找所给定的 olditem, 然后再依据所给定的 newitem 来取代每一个 olditem。但当找不到 list 中的 olditem 时, 此函数将返回原有的 list。
;cons 它是“构造”(construct) 表的最基本函数, 它将一个元素 (new-first-element) 与一个表 (list) 接合起来, 并返回以此新元素为首的新表。
;assoc 此函数将在联合表 (association list) alist 中搜寻以item 为名称的对应值, 如果找到, 则 assoc 会返回其对应值。若找不到, 则会返回 nil。
   (entmod ent1); entmod 函数来更新数据库内的图元。
   (setq ent2 (subst (cons 10 pt)(assoc 10 ent2) ent2))
   (entmod ent2)
   (setq ent2 (subst (cons 11 (trans (polar (trans pt 0 1) 0 le) 1 0))(assoc 11 ent2) ent2))
   (entmod ent2)
   (setq ent3 (subst '(72 . 0) (assoc 72 ent3) ent3))
   (setq ent3 (subst (cons 10 (list (+ (car pt) jl) (+ (cadr pt) zj)))(assoc 10 ent3) ent3))
   (setq ent3 (subst (cons 11 (list (+ (car pt) jl) (+ (cadr pt) zj)))(assoc 11 ent3) ent3))
   (entmod ent3)
   )
(progn
   (setq pt (trans pt 1 0))
   (setq ent1 (subst (cons 11 pt)(assoc 11 ent1) ent1))
   (entmod ent1)
   (setq ent2 (subst (cons 10 pt)(assoc 10 ent2) ent2))
   (entmod ent2)
   (setq ent2 (subst (cons 11 (trans (polar (trans pt 0 1) PI le) 1 0))(assoc 11 ent2) ent2))
   (entmod ent2)
   (setq ent3 (subst '(72 . 2) (assoc 72 ent3) ent3))
   (setq ent3 (subst (cons 10 (list (- (car pt) jl) (+ (cadr pt) zj)))(assoc 10 ent3) ent3))
   (setq ent3 (subst (cons 11 (list (- (car pt) jl) (+ (cadr pt) zj)))(assoc 11 ent3) ent3))
   (entmod ent3)
   )
)
    );while
;;|;;
  (princ)
  )
(defun c:A ()
(setq AA (getvar "clayer"))
(setq layer "文字     text")(if (not (tblsearch "layer" layer ))
  (progn (command "layer" "new" "文字     text" "s" "文字     text" "C" 212 "" "L" "Continuous" "" "LW" 0.2 "" "")
))
     (COMMAND "CLAYER" layer)
    (setvar "texteval" 1)
    (setvar "cmdecho" 0)
    (setq vv (getvar "osmode"))
;;;     (setq ht (getreal "\n-->标注字高默认:2.5)"))
(setq ht 3);暂用固定练习
   (if (= ht nil) (setq ht 2.5))
    (setq zj (/ ht 3))
    (setq n 0)
    (while (= n 0)
;;;       (setq TXT (getstring "\n-->请输入文字:"))
(setq TXT "操作练习");暂用固定练习
     (setvar "osmode" 33)
      (if (/= txt "")
         (setq   p1 (getpoint "\n-->请指定点坐标:")
        )
)
     (if (= txt "") (setq n 1)(zcx))
)
    (setvar "osmode" vv)
    (princ)
)
;;;以下是一个找来的用图元方法画多线,但不知如何在动态中更新,也请大师指点
(defun HDX (pts XK)
  (if (entmake
(append (list '(0 . "LWPOLYLINE")
        '(100 . "AcDbEntity")
        '(100 . "AcDbPolyline")
        (cons 90 (length pts))
                      (cons 43 xk)
  )
(mapcar '(lambda (x) (cons 10 (trans x 1 0))) pts)
  '((210 0. 0. 1.))
)
      )
    (entlast)
  )
)

springwillow

ynhh 发表于 2013-1-27 17:24
感谢大师的热心指点.
你说的很有道理

看看吧，是不是这样

2. (defun zcx()
   
3.     (setvar "osmode" 0)
   
4.     ;(setq p2 (getpoint P1 "\n-->请指定文字位置:")
   
5.   (setq p2 (polar p1 0 10)
   
6.         a1 (car p1 )
   
7.         c1 (car p2)
   
8.         vx (* (- (strlen TXT) 0.2) (* ht 0.75))     
   
9.         le vx
   
10.     )
    
11.     (if (< c1 a1)
    
12.     (setq pp (polar p2 pi le)
    
13.    p3 (polar pp (/ pi 2) zj)
    
14.     )
    
15.   (setq pp (polar p2 0 le)
    
16. p3 (polar p2 (/ pi 2) zj)
    
17.   ))
    
18.   (setq en1 (HDX (list (setq p11 (polar p1 0 0.1)) p2 PP) 0.1))
    
19.   ;(command "line" p2 pp "")
    
20.   ;(setq en2 (entlast))
    
21.   
    
22. ;;;请教大师:我想到两根直线合并为一根带线宽的多线,但不知如何实现动态更新?有此功能吗?如有请教方法，感谢你。
    
23. (setq XK 0.3);设置线宽
    
24. (setq en20 (HDX (list p1 PP) XK));画带线宽的多线)
    
25.   
    
26. ;;;  (command "text" P3 ht 0 TXT)
    
27. (command "TEXT" "J" "ML" P3 ht "0" TXT);----画样式写入文字
    
28.   (setq en3 (entlast));entlast 返回最后一个未删除的主图元名。
    
29.   (setq ent1 (entget en1); entget 此函数将由数据库中取出 ename 的图元, 同时返回一表
    
30. ;ent2 (entget en2)
    
31. ent3 (entget en3))
    
32.   (setq le1 (caadr (textbox ent3))); textbox 这个函数将计算一个文字图元并返回包围文字的交互坐标框。
    
33.   (setq le (* 1.2 le1)
    
34. jl (* 0.1 le1))
    
35. ;;|;;
    
36.   (while (= (car (setq mouse (grread t 0 0))) 5)
    
37.       (setq pt (cadr mouse))
    
38.       
    
39.       (if (>= (car pt)(car p1))
    
40. (progn
    
41. ;以下句子可自行简写
    
42.     (setq pt (polar pt 0 1))
    
43.    (setq pt (trans pt 1 0))
    
44.    (setq ent1 (subst (cons 10 (3D->2D pt))(cons 10 (3D->2D p2)) ent1))
    
45.   (setq p2 pt)
    
46.   (setq ent1 (subst (cons 10 (3D->2D(trans (polar  pt 0 le) 1 0)))(cons 10 (3D->2D pp)) ent1))
    
47.   (setq pp (trans (polar (trans pt 0 1) 0 le) 1 0))
    
48.    (setq ent1 (subst (cons 10 (3D->2D p1))(cons 10 (3D->2D p11)) ent1))
    
49. ; subst 此函数将在 list 寻找所给定的 olditem, 然后再依据所给定的 newitem 来取代每一个 olditem。但当找不到 list 中的 olditem 时, 此函数将返回原有的 list。
    
50. ;cons 它是“构造”(construct) 表的最基本函数, 它将一个元素 (new-first-element) 与一个表 (list) 接合起来, 并返回以此新元素为首的新表。
    
51. ;assoc 此函数将在联合表 (association list) alist 中搜寻以item 为名称的对应值, 如果找到, 则 assoc 会返回其对应值。若找不到, 则会返回 nil。
    
52.    (entmod ent1); entmod 函数来更新数据库内的图元。
    
53.    (setq ent3 (subst '(72 . 0) (assoc 72 ent3) ent3))
    
54.    (setq ent3 (subst (cons 10 (list (+ (car pt) jl) (+ (cadr pt) zj)))(assoc 10 ent3) ent3))
    
55.    (setq ent3 (subst (cons 11 (list (+ (car pt) jl) (+ (cadr pt) zj)))(assoc 11 ent3) ent3))
    
56.    (entmod ent3)
    
57.    )
    
58. (progn
    
59.    (setq pt (trans pt 1 0))
    
60.    (setq ent1 (subst (cons 10 (3D->2D pt))(cons 10 (3D->2D p2)) ent1))
    
61.   (setq p2 pt)
    
62.   (setq ent1 (subst (cons 10 (3D->2D (trans (polar (trans pt 0 1) PI le) 1 0)))(cons 10 (3D->2D pp)) ent1))
    
63.   (setq pp (trans (polar (trans pt 0 1) PI le) 1 0))
    
64.    (entmod ent1)
    
65.    (setq ent3 (subst '(72 . 2) (assoc 72 ent3) ent3))
    
66.    (setq ent3 (subst (cons 10 (list (- (car pt) jl) (+ (cadr pt) zj)))(assoc 10 ent3) ent3))
    
67.    (setq ent3 (subst (cons 11 (list (- (car pt) jl) (+ (cadr pt) zj)))(assoc 11 ent3) ent3))
    
68.    (entmod ent3)
    
69.    )
    
70. )
    
71.     );while
    
72. ;;|;;
    
73.   (princ)
    
74.   )
    
75. (defun c:A ()
    
76. (setq AA (getvar "clayer"))
    
77. (setq layer "文字     text")(if (not (tblsearch "layer" layer ))
    
78.   (progn (command "layer" "new" "文字     text" "s" "文字     text" "C" 212 "" "L" "Continuous" "" "LW" 0.2 "" "")
    
79. ))
    
80.      (COMMAND "CLAYER" layer)
    
81.     (setvar "texteval" 1)
    
82.     (setvar "cmdecho" 0)
    
83.     (setq vv (getvar "osmode"))
    
84. ;;;     (setq ht (getreal "\n-->标注字高:(默认:2.5)"))
    
85. (setq ht 3);暂用固定练习
    
86.    (if (= ht nil) (setq ht 2.5))
    
87.     (setq zj (/ ht 3))
    
88.     (setq n 0)
    
89.     (while (= n 0)
    
90. ;;;       (setq TXT (getstring "\n-->请输入文字:"))
    
91. (setq TXT "操作练习");暂用固定练习
    
92.      (setvar "osmode" 33)
    
93.       (if (/= txt "")
    
94.          (setq   p1 (getpoint "\n-->请指定点坐标:")
    
95.         )
    
96. )
    
97.      (if (= txt "") (setq n 1)(zcx))
    
98. )
    
99.     (setvar "osmode" vv)
    
100.     (princ)
     
101. )
     
102. ;;;以下是一个找来的用图元方法画多线,但不知如何在动态中更新,也请大师指点
     
103. (defun HDX (pts XK)
     
104.   (if (entmake
     
105. (append (list '(0 . "LWPOLYLINE")
     
106.         '(100 . "AcDbEntity")
     
107.         '(100 . "AcDbPolyline")
     
108.         (cons 90 (length pts))
     
109.                       (cons 43 xk)
     
110.   )
     
111. (mapcar '(lambda (x) (cons 10 (trans x 1 0))) pts)
     
112.   '((210 0. 0. 1.))
     
113. )
     
114.       )
     
115.     (entlast)
     
116.   )
     
117. )
     
118. (defun 3D->2D (p /)
     
119.    (list (car p)(cadr p))
     
120.    )
     

(defun zcx()<br />     (setvar "osmode" 0)<br />     ;(setq p2 (getpoint P1 "\n-->请指定文字位置:")<br />   (setq p2 (polar p1 0 10)<br />         a1 (car p1 )<br />         c1 (car p2)<br />         vx (* (- (strlen TXT) 0.2) (* ht 0.75))     <br />         le vx<br />     )<br />     (if (< c1 a1)<br />     (setq pp (polar p2 pi le)<br />    p3 (polar pp (/ pi 2) zj)<br />     ) <br />   (setq pp (polar p2 0 le)<br /> p3 (polar p2 (/ pi 2) zj)<br />   ))<br />   (setq en1 (HDX (list (setq p11 (polar p1 0 0.1)) p2 PP) 0.1))<br />   ;(command "line" p2 pp "")<br />   ;(setq en2 (entlast))<br />   <br /> ;;;请教大师:我想到两根直线合并为一根带线宽的多线,但不知如何实现动态更新?有此功能吗?如有请教方法，感谢你。<br /> (setq XK 0.3);设置线宽<br /> (setq en20 (HDX (list p1 PP) XK));画带线宽的多线)<br />   <br /> ;;;  (command "text" P3 ht 0 TXT)<br /> (command "TEXT" "J" "ML" P3 ht "0" TXT);----画样式写入文字<br />   (setq en3 (entlast));entlast 返回最后一个未删除的主图元名。<br />   (setq ent1 (entget en1); entget 此函数将由数据库中取出 ename 的图元, 同时返回一表<br /> ;ent2 (entget en2)<br /> ent3 (entget en3))<br />   (setq le1 (caadr (textbox ent3))); textbox 这个函数将计算一个文字图元并返回包围文字的交互坐标框。<br />   (setq le (* 1.2 le1)<br /> jl (* 0.1 le1))<br /> ;;|;;<br />   (while (= (car (setq mouse (grread t 0 0))) 5)<br />       (setq pt (cadr mouse))<br />       <br />       (if (>= (car pt)(car p1))<br /> (progn<br /> ;以下句子可自行简写<br />     (setq pt (polar pt 0 1))<br />    (setq pt (trans pt 1 0))<br />    (setq ent1 (subst (cons 10 (3D->2D pt))(cons 10 (3D->2D p2)) ent1))<br />   (setq p2 pt)<br />   (setq ent1 (subst (cons 10 (3D->2D(trans (polar  pt 0 le) 1 0)))(cons 10 (3D->2D pp)) ent1))<br />   (setq pp (trans (polar (trans pt 0 1) 0 le) 1 0))<br />    (setq ent1 (subst (cons 10 (3D->2D p1))(cons 10 (3D->2D p11)) ent1))<br /> ; subst 此函数将在 list 寻找所给定的 olditem, 然后再依据所给定的 newitem 来取代每一个 olditem。但当找不到 list 中的 olditem 时, 此函数将返回原有的 list。<br /> ;cons 它是“构造”(construct) 表的最基本函数, 它将一个元素 (new-first-element) 与一个表 (list) 接合起来, 并返回以此新元素为首的新表。<br /> ;assoc 此函数将在联合表 (association list) alist 中搜寻以item 为名称的对应值, 如果找到, 则 assoc 会返回其对应值。若找不到, 则会返回 nil。<br />    (entmod ent1); entmod 函数来更新数据库内的图元。<br />    (setq ent3 (subst '(72 . 0) (assoc 72 ent3) ent3))<br />    (setq ent3 (subst (cons 10 (list (+ (car pt) jl) (+ (cadr pt) zj)))(assoc 10 ent3) ent3))<br />    (setq ent3 (subst (cons 11 (list (+ (car pt) jl) (+ (cadr pt) zj)))(assoc 11 ent3) ent3))<br />    (entmod ent3)<br />    )<br /> (progn<br />    (setq pt (trans pt 1 0))<br />    (setq ent1 (subst (cons 10 (3D->2D pt))(cons 10 (3D->2D p2)) ent1))<br />   (setq p2 pt)<br />   (setq ent1 (subst (cons 10 (3D->2D (trans (polar (trans pt 0 1) PI le) 1 0)))(cons 10 (3D->2D pp)) ent1))<br />   (setq pp (trans (polar (trans pt 0 1) PI le) 1 0))<br />    (entmod ent1)<br />    (setq ent3 (subst '(72 . 2) (assoc 72 ent3) ent3))<br />    (setq ent3 (subst (cons 10 (list (- (car pt) jl) (+ (cadr pt) zj)))(assoc 10 ent3) ent3))<br />    (setq ent3 (subst (cons 11 (list (- (car pt) jl) (+ (cadr pt) zj)))(assoc 11 ent3) ent3))<br />    (entmod ent3)<br />    )<br /> )<br />     );while<br /> ;;|;;<br />   (princ)<br />   )<br /> (defun c:A ()<br /> (setq AA (getvar "clayer"))<br /> (setq layer "文字     text")(if (not (tblsearch "layer" layer )) <br />   (progn (command "layer" "new" "文字     text" "s" "文字     text" "C" 212 "" "L" "Continuous" "" "LW" 0.2 "" "")<br /> ))<br />      (COMMAND "CLAYER" layer)<br />     (setvar "texteval" 1)<br />     (setvar "cmdecho" 0)<br />     (setq vv (getvar "osmode"))<br /> ;;;     (setq ht (getreal "\n-->标注字高:(默认:2.5)"))<br /> (setq ht 3);暂用固定练习<br />    (if (= ht nil) (setq ht 2.5))<br />     (setq zj (/ ht 3))<br />     (setq n 0)<br />     (while (= n 0)<br /> ;;;       (setq TXT (getstring "\n-->请输入文字:"))<br /> (setq TXT "操作练习");暂用固定练习<br />      (setvar "osmode" 33)<br />       (if (/= txt "")<br />          (setq   p1 (getpoint "\n-->请指定点坐标:")<br />         )<br /> )<br />      (if (= txt "") (setq n 1)(zcx))<br /> )<br />     (setvar "osmode" vv)<br />     (princ)<br /> )<br /> ;;;以下是一个找来的用图元方法画多线,但不知如何在动态中更新,也请大师指点<br /> (defun HDX (pts XK)<br />   (if (entmake<br /> (append (list '(0 . "LWPOLYLINE")<br />         '(100 . "AcDbEntity")<br />         '(100 . "AcDbPolyline")<br />         (cons 90 (length pts))<br />                       (cons 43 xk) <br />   )<br /> (mapcar '(lambda (x) (cons 10 (trans x 1 0))) pts)<br />   '((210 0. 0. 1.))<br /> )<br />       )<br />     (entlast)<br />   )<br /> )<br /> (defun 3D->2D (p /)<br />    (list (car p)(cadr p))<br />    )<br />

xiabin68

收藏了，，，，，，，，