合并程序

泥水匠乐悠悠 发表于 2016-4-24 23:25:53

1,将任意样式文字改为黑体字，字高600，宽度因子0.6
2,在黑体字下画一条PL线，线宽100，线距文字280
3,请将上面2个程序合并，即：选文字，输入文字与PL线间距后，达到效果
4,用于统一结构图图名格式

;改变字型为黑体
(defun c:ht (/ ss n q kk s ob)
(setq oerr *error* *error* nerr)
(setvar"cmdecho"0)
(setvar "plinetype" 2)
(if (not (tblsearch "style" "黑体"))(command "-style" "黑体" "SIMHEI.TTF" "" "0.60" "" "" "" ""))
(prompt "\n改变字型为黑体!")
(prompt"\n选要改动的文本:")
(setq ss (ssget))
(setq n (sslength ss))
(setq q 0)
(setq kk 0)
(repeat n
(setq ssn (ssname ss q))
(setq s (entget (ssname ss q)))
(setq ob (assoc 0 s))
(if (= (cdr ob) "TEXT")
   (progn
      (setq s (subst (cons 7 "黑体") (assoc 7 s) s))
      (setq s (subst (cons 41 0.6) (assoc 41 s) s))
      (setq s (subst (cons 40 600) (assoc 40 s) s))
      (entmod s)
      (entupd s)
      (setq kk (1+ kk))
   )
)
(setq q (1+ q))
; (princ q)
)
(prompt"\n被改文本数目:")
(princ kk)
(setq *error* oerr)
(setvar"cmdecho"1)
(princ)
)

;;字下画PL线
(defun c:hx (/ os cl dd ss i ssn ssdata key box p1 p3 p2 p4 p1a p2a)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "plinetype" 2)
(setq cl (getvar "clayer"))
(setq tsy (getvar "textstyle"))
(if (not (tblsearch "style" "黑体"))(command "-style" "黑体" "SIMHEI.TTF" "" "0.60" "" "" "" ""))
;(setvar "textstyle" "黑体")
(setq dd (getdist "\n字与线间距 <280>: "))
(if (null dd) (setq dd 280.0))
(command "-layer" "m" "mytm" "c" "7" "mytm" "")
(setq ss (ssget))
(setq i 0)
(repeat (sslength ss)
   (setq ssn (ssname ss i))
   (setq ssdata (entget ssn))
   ;(setq pt (cdr (assoc 11 ssdata)))
   (setq key (cdr (assoc 0 ssdata)))
   (if (= key "TEXT")
      (progn
         (command "ucs" "e" ssn)
         (setq box (textbox ssdata))
         (setq p1 (car box))
         (setq p3 (cadr box))
         (setq p2 (list (car p3) (cadr p1)))
         (setq p4 (list (car p1) (cadr p3)))
         (setq p1a (polar p1(angle p2 p1) 130))
         (setq p2a (polar p2(angle p1 p2) 130))
         (command "pline" (polar p1a (angle p4 p1) dd) "w" "100" "" (polar p2a (angle p4 p1) dd) "")
         (command "change" ss "" "p" "la" (getvar "clayer") "")
      )
   )
   (setq i (1+ i))
)
(command "ucs" "")
(setvar "osmode" os)
(setvar "clayer" cl)
(prin1)
)

泥水匠乐悠悠 发表于 2016-4-25 00:10:39

不会做图片，发张dwg图例

ZZXXQQ 发表于 2016-4-25 08:27:57

(defun c:hx (/ os cl dd ss i ssn ssdata key box p1 p3 p2 p4 p1a p2a)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "plinetype" 2)
(setq cl (getvar "clayer"))
(setq tsy (getvar "textstyle"))
(if (not (tblsearch "style" "黑体"))(command "-style" "黑体" "SIMHEI.TTF" "" "0.60" "" "" "" ""))
;(setvar "textstyle" "黑体")
(setq dd (getdist "\n字与线间距 <280>: "))
(if (null dd) (setq dd 280.0))
(command "-layer" "m" "mytm" "c" "7" "mytm" "")
(setq ss (ssget '((0 . "TEXT"))))
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
;(setq pt (cdr (assoc 11 ssdata)))
(setq key (cdr (assoc 0 ssdata)))
(setq ssdata (subst (cons 7 "黑体") (assoc 7 ssdata) ssdata))
(setq ssdata (subst (cons 41 0.6) (assoc 41 ssdata) ssdata))
(setq ssdata (subst (cons 40 600) (assoc 40 ssdata) ssdata))
(entmod ssdata)
(entupd ssn)
(command "ucs" "e" ssn)
(setq box (textbox ssdata))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(setq p1a (polar p1(angle p2 p1) 130))
(setq p2a (polar p2(angle p1 p2) 130))
(command "pline" (polar p1a (angle p4 p1) dd) "w" "100" "" (polar p2a (angle p4 p1) dd) "")
(command "change" ss "" "p" "la" (getvar "clayer") "")
(setq i (1+ i))
)
(command "ucs" "")
(setvar "osmode" os)
(setvar "clayer" cl)
(prin1)
)

LIULISHENG 发表于 2016-4-25 08:53:42

学习了我顶

泥水匠乐悠悠 发表于 2016-4-26 00:43:13

感谢ZZXXQQ,改得很好用

hdlyt11 发表于 2016-4-29 11:48:33

如果文字大小可以根据比例调整就好了，或者可以选择设置字体的大小

泥水匠乐悠悠 发表于 2016-5-2 00:22:28

hdlyt11 发表于 2016-4-29 11:48 static/image/common/back.gif
如果文字大小可以根据比例调整就好了，或者可以选择设置字体的大小

可以实现的，需要输入出图比例，只是输入参数多了，反而降低了实用性

泥水匠乐悠悠 发表于 2016-5-2 00:23:03

泥水匠乐悠悠 发表于 2016-5-2 00:29:36

;将图名文字样式改为黑体，并在文字下面画PL线，线宽100
;用于统一图名格式，出图比例1:100时，字高为600
;感谢明经ZZXXQQ帮助修改
(defun c:hx (/ os plwid cl tsy dd sc1 sc ss i ssn ssdata key box p1 p3 p2 p4 p1a p2a)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "plinetype" 2)
(setq plwid (getvar "plinewid"))
(setq cl (getvar "clayer"))
(setq tsy (getvar "textstyle"))
(if (not (tblsearch "style" "黑体"))(command "-style" "黑体" "SIMHEI.TTF" "" "0.60" "" "" "" ""))
;(setvar "textstyle" "黑体")
(prompt "\n将图名文字样式改为黑体，并在文字下面画PL线，线宽100，用于出图比例1:100")
(setq dd (getdist "\n字与线间距 <280>: "))
(if (null dd) (setq dd 280.0))
(setq sc1 (getdist "\n出图比例<默认值:1:100>:"))
(if (not sc1) (setq sc1 100))
(setq sc (/ sc1 100))
(command "-layer" "m" "mytm" "c" "7" "mytm" "")
(setq ss (ssget '((0 . "TEXT"))))
(setq i 0)
(repeat (sslength ss)
(setq ssn (ssname ss i))
(setq ssdata (entget ssn))
;(setq pt (cdr (assoc 11 ssdata)))
;(setq key (cdr (assoc 0 ssdata)))
(setq ssdata (subst (cons 7 "黑体") (assoc 7 ssdata) ssdata))
(setq ssdata (subst (cons 41 0.6) (assoc 41 ssdata) ssdata))
(setq ssdata (subst (cons 40 (* sc 600)) (assoc 40 ssdata) ssdata))
(entmod ssdata)
(entupd ssn)
;(command "ucs" "e" ssn)
(command "ucs" "ob" ssn)
(setq box (textbox ssdata))
(setq p1 (car box))
(setq p3 (cadr box))
(setq p2 (list (car p3) (cadr p1)))
(setq p4 (list (car p1) (cadr p3)))
(setq p1a (polar p1(angle p2 p1) (* sc 130)))
(setq p2a (polar p2(angle p1 p2) (* sc 130)))
(command "pline" (polar p1a (angle p4 p1) (* sc dd)) "w" (* sc 100) "" (polar p2a (angle p4 p1) (* sc dd)) "")
(command "change" ss "" "p" "la" (getvar "clayer") "")
(setq i (1+ i))
)
(command "ucs" "")
(setvar "osmode" os)
(setvar "clayer" cl)
(setvar "plinewid" plwid)
(prin1)
)

kugoo999 发表于 2019-1-23 16:32:15

很强大，谢谢

页: [1]

明经CAD社区's Archiver

合并程序