怎么没有二次开发的？

ZWX168

比如比例问题，图纸比例不是1：1，单行文字，多行文字的字高要改变，表注箭头、字高要改变，画图中途改变比例，所有的要改变样式吗？
有没有一个小程序一次搞定？

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：BL，按提示Scale factor:输入值，即可改变全部文字的字高
( N9 x: b2 k# V, c' T+ C注意：标题块、图框最好作成图块，不然它们中的字字高也变了！！！！！！！！

4 i7 \% s8 E- q( z9 P3 r(defun c:bl()
(setq val (getreal "Scale factor: "))
  k7 B4 A( Q2 q* G. P, d;;默认文字字高4.0mm
(setq high (* 4 val))
(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
(setq N (- (sslength ssl) 1))
6 L2 D0 D  J. {+ g: w7 V! B8 X$ ?(setq test 0)
(while (<= test  N )
& @8 c+ a. I. P3 s1 I2 V(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
( ?( n) A6 V* J) e4 T(entmod DIMENSION)
+ M* y, j, R0 ?- F1 n8 A(setq test (+ 1 test))
)
; P* ]" _1 a+ H* c2 e. n8 C(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
6 I, c- r( \9 i' w# O9 T8 J7 N$ F(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
3 ?5 S3 M: z8 T2 T- [(setq DIMENSION (ENTGET (ssname ssl test)))
7 |: O) Q3 C% z9 _& K; J(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
(entmod DIMENSION)
(setq test (+ 1 test))
$ ~0 X! x+ x; h' N* k)
: L4 b  a, L" k6 K)

cad

确实比较少。原来论坛有相关版块的，因为参与的人少，撤掉了。现在作为一个分类
% K% X/ N1 t" T9 x" Ohttp://www.askcad.com/bbs/forumd ... r=type&typeid=4

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：DIMBL，按提示Scale factor:输入值，即可改变全部标注文字的字高、箭头的大小。
3 T+ D# u, W5 y$ c8 S; X
- a8 i# O. z2 m# W5 i9 w(defun cIMbl()
' d  z- n8 h5 ]. [$ W7 t0 g! E2 x7 ~(setq val (getreal "Scale factor: "))
(setvar "DIMSCALE" val)
+ g1 z6 V3 C4 e( [(setvar "DIMASZ" 2)
(setvar "DIMTXT" 3.5)
  d8 C  V- ?* e2 o- ?: k5 ?* r: D- ](setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
5 |# J% N/ f" l& _(command "dim" "update" ssl "" "exit")
2 b) ?  \4 E$ ]4 q" M4 M# q9 o) q(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
) N( U, `1 A. K0 `* S) t(command "dim" "update" ssl "" "exit")
( e' x6 N& u: R, D9 [% E* U; o)

ZWX168

剖面线由于比例不统一，有的太密，有的太稀。下面的程序可以把全部剖面线比例统一。
1 ^  Z5 S3 B9 w! b/ a+ M
(defun c:HCbl()
(setq val (getreal "Scale factor: "))
9 p8 k6 |5 j: }(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
(setq SS NIL)
0 E) b/ G- _. g) ~0 s+ l(setq ss (ssadd))
(ssadd (ssname ssl test) SS)
(command "-hatchedit" ss "" "" val "")
(setq test (+ 1 test))
)
# u) d- U9 O# Q- c2 \  Y)

砖要抛没了！！！！！！！
玉还不出来吗？
3 R. s0 b+ \* ?1 O; q: z1 m2 y5 @
& ?8 w) ~9 Z6 Y6 w$ z$ t0 \ :'(

ZWX168

我做图时习惯把虚线、点划线、双点划线分别放在单独的图层，由于粘贴的图形导致同一线形的线形比例不同，很难看，下面的程序可以把选中的线所在图层的全部图线的线形比例统一

& `- X# m9 g/ `8 Q8 B! P(defun cSbl()
(setq  DIMENSION (entget (car (entsel "lease choose an object:" ))))
; Y$ Q0 }+ P' l6 D/ n: D. S(setq val (getreal "New linetype Scale : "))
0 z$ m& H  u% S6 a(setq TEXT (cdr (assoc '8 DIMENSION)))
(setq ssl (ssget "X" (list (cons 8 TEXT))))
( a7 w( m: x( U) {! H- z(command "ChPROP" ssl "" "S"  val "")
9 C+ h5 w% W- V3 z! P! Z, f)

ZWX168

有的时候，打剖面线，有些中心线、虚线、双点划线、序号指引线捣乱，要多选几个剖面区域，下面的程序可以把那些捣乱的线所在的图层冻结。

(defun c:FreezeMe()
! {# i/ K$ q" x/ t. p(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
(setq TEXT (cdr (assoc '8 DIMENSION)))
6 d8 b/ s/ B. H& [: P: o(setq Cname (getvar "clayer"))
(if  (/= Cname TEXT)
(command "layer" "F" TEXT "")
(progn
(setq templist (tblnext "LAYER" T))
* K3 n7 t& ]/ K(while templist
(setq name (cdr (assoc 2 templist)))
(if  (/= name TEXT)
7 U- [+ {7 \9 F6 V(progn
8 G5 P- ~: [& k  c0 Y0 S5 ?(setvar "clayer" name)
(command "layer" "F" TEXT "")
) K4 H! X3 m2 j1 i(setq templist nil)
0 m+ d3 a" K4 Y3 T1 I+ q3 |)
(setq templist (tblnext "LAYER"))
: y4 Q5 a- |- K& o0 T: ^)
)
% W! @5 S  ?1 j5 _3 e)
5 j" q  ~) R0 J/ r9 O/ x4 u( Y)
)

ZWX168

这个程序是楼上的反向选择，冻结所选实体所在图层以外的全部图层

(defun c:FreezeOther()
8 J8 T' y4 `) y0 A' a(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
3 i# H! o# P( ?7 r(setq TEXT (cdr (assoc '8 DIMENSION)))
' L/ d+ K) \5 Z" ?; n(setvar "clayer" TEXT)
(setq Cname (getvar "clayer"))
(command "layer" "F" TEXT "")
7 b$ q. B7 I+ R2 U; {0 D5 I; l(setq templist (tblnext "LAYER" T))
(while templist
(setq name (cdr (assoc 2 templist)))
(if  (/= name TEXT) (command "layer" "F" name ""))
(setq templist (tblnext "LAYER"))
)
)

ZWX168

解冻全部图层

) {. Q, R- i) D3 S(defun c:unFreezeAll()
(setq templist (tblnext "LAYER" T))
(while templist
(setq name (cdr (assoc 2 templist)))
3 Q( x, n- k( _/ B(command "layer" "T" name "")
* i# Z+ m1 t9 z% m(setq templist (tblnext "LAYER"))
/ i& z  i$ f* \)
  J1 @6 Z9 f0 q7 f(command "_regenall")
; t/ ]  @! ~% x: @7 ]* l2 F2 ^. m0 Q0 t)

cad

下次回复有代码的时候，勾选“禁用 Smilies”，就不会出现六楼那样的笑脸符号

ZWX168

重画剖面线：如果剖面线的边界发生变化，如拉伸后剖面线没有与边界同步调整，下面的程序可以“修复剖面线”。只对简单的图形有效（《=3 个分开的图形）。当然图形得是封闭的，原来的剖面线位置变化不大。

) A. g4 D' |. {; G(defun C:hath()
" I8 G& `* s; U% B2 R/ s: T- V(setq  DIMENSION  (car (entsel)))
(setq SSL NIL)
(setq ssL (ssadd))
(ssadd DIMENSION SSL)
& p* P2 X7 U" g0 G(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
(if (<= no 3)
(progn
) n; U7 t9 I+ f+ T- S' i3 P- o(if (= no 1)
(progn
(setq l1 (length DIMENSION))
! v. S; i9 S: r$ k: `  \(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(command "-bhatch" p1 "")
(command "_erase" SSL "")
))
(if (= no 2)
(progn
0 }' y6 F/ [& ?; O  `* T(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
. E" Z0 n% f; l3 M  s( v. A, p(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(command "-bhatch" p1 p2 "")
  g( j  I. P* r4 {* u5 H(command "_erase" SSL "")
))
4 Y/ J, Q# h2 P) M1 m  D(if (= no 3)
(progn
* ~* ~; M& Q3 N' q(setq l1 (length DIMENSION))
% }% W4 z* O( O; W. J" [(setq p1 (cdr (nth (- l1 1) DIMENSION)))
  V$ e& W3 u; U# @/ z' E" M7 M(setq p2 (cdr (nth (- l1 2) DIMENSION)))
4 b6 k) J4 e5 N7 N' e4 e, J: f9 l(setq p3 (cdr (nth (- l1 3) DIMENSION)))
(command "-bhatch" p1 p2 p3 "")
(command "_erase" SSL "")
7 f- ]9 |8 q* L0 Y2 W, x9 A# {))
$ R% j7 R$ [( a2 Y( A8 {) `8 W))
+ W5 B7 `# Q# [' a5 T5 ?, @(if (> no 3)(prompt "请选择简单图形！"))
)

ZWX168

楼上的程序“修复”的剖面线没有继承原来的属性。
6 Q6 b6 R- o8 w, f8 u6 t更正以下，没有继承图层属性。也没有必要。

+ D( R3 E; B0 _1 d# o(defun C:hath()
(setq  DIMENSION  (car (entsel)))
(setq SSL NIL)
$ C2 ^" \% W- Q2 e* z& R* v(setq ssL (ssadd))
5 O+ ^; m# D/ G* @! \(ssadd DIMENSION SSL)
(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
(setq name (cdr (assoc '2 DIMENSION)))
+ @# R/ U1 @5 J7 q/ \' W(setq Scale (cdr (assoc '41 DIMENSION)))
- V" w; Y# l# N(setq angle (cdr (assoc '52 DIMENSION)))
(setq angle (angtos  angle 0 0))
(if (<= no 3)
(progn
(if (= no 1)
: }5 s9 g3 P0 c2 ?/ r(progn
/ }* e5 g: y" b, [0 T) L2 h(setq l1 (length DIMENSION))
9 l0 x" R6 `9 H, B  b% b(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1"")
(command "_erase" SSL "")
))
; ?: k" @+ [2 C- H* O6 B(if (= no 2)
(progn
8 J( Z* {; Z1 \6 W7 ]* p3 F(setq l1 (length DIMENSION))
* D2 |3 F% b/ Q! A) _" W$ q(setq p1 (cdr (nth (- l1 1) DIMENSION)))
- D6 {( I! `: g+ R(setq p2 (cdr (nth (- l1 2) DIMENSION)))
: M( W$ {) I; w# C' M(command "-bhatch" "P"  name Scale angle p1 p2 "")
# v7 Z. }7 w2 k) U(command "_erase" SSL "")
: h( U( j# R$ l3 M& r- H))
* ]7 B, |9 b5 O  @* }0 S(if (= no 3)
(progn
. X6 u7 l' e: Q- a- M(setq l1 (length DIMENSION))
& z  `8 J6 S; U# X1 N& z) p(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(setq p3 (cdr (nth (- l1 3) DIMENSION)))
; H# c7 r5 t) z6 I+ f9 O(command "-bhatch" "P"  name Scale angle p1 p2 p3 "")
, a. r0 D- A3 X6 t/ {( w: V(command "_erase" SSL "")
% W; Y& |8 A; h))
2 p+ `+ L$ w' f! Y) D5 F% j))
+ U/ _; v. N: M6 N# b: u(if (> no 3)(prompt "请选择简单图形！"))
)

ZWX168

习惯上CAD画图要分若干个图层，例如："1文字"、"2标注"、"3剖面"等，下面的程序可以把不同分类的实体分别放到各自的图层中，“各就各位！”
6 X( q6 t* B% d  f3 V(defun c:movelayer ()
) x$ y! Y  m4 v3 C7 v% o  @; n5 N(setq layname "1文字")
9 E2 [9 L7 @. @: H: I; }(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
/ [9 l  X+ }+ Y- d, @# Z(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq layname "2标注")
+ e8 z; `7 F, E(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
# b2 p+ N% x% n* r' ~7 w8 m2 ~(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
- c' t, E4 j- ~( S(setq layname "3剖面")
+ g* v3 |! v& s4 }(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
/ T) S  @+ ?5 I$ W(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
6 j/ G" X$ H' V7 L0 j)

ZWX168

下面的程序可以根据选择的对象显示不同的对话框。
, _5 P& B  `& f前提是确定已经加载了ddchprop.LSP和  ddmodify.LSP
(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddchprop")
; B6 e% @, f5 u# g8 D- r8 V9 z(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddmodify")
0 {3 p# d% \8 j- r
2 c2 w6 d1 H! i% x: s
1 k% Q7 n! Q2 Z0 ~7 P
. _# b( E8 ]  A5 ~6 b' h2 i(defun C:ai_propchk()
(setq SSL (SSGET))
0 Q, ^4 A$ v( W2 L1 }(IF (= (sslength ssL) 1)
(progn
$ O* n6 N* v3 r) C( K0 _(setq  DIMENSION (entget (ssname ssL 0)))
(setq TEXT (cdr (assoc '0 DIMENSION)))
(setq set 0)
- x0 R6 z1 v: P( D3 n6 i) M! o- @(if (= TEXT  "TEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
8 Z4 j9 ~  v' K& _(if (= TEXT  "MTEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
(if (= TEXT  "DIMENSION") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
; Y% M! j) ]+ X(if (= TEXT  "HATCH") (progn (COMMAND "_hatchedit" SSL) (setq set 1)))
(if (= TEXT  "INSERT") (progn (COMMAND "_ddatte" SSL) (setq set 1)))
(if (= set 0) (ddmodify (ssname ssL 0)))
. N' v6 v$ u! G* C; Y' K- {)
; j1 r! g5 v+ p+ L)
(IF (> (sslength ssL) 1) (ddchprop ssl))
) T3 {7 H* C; a/ F* l)

ZWX168

图纸中标注的尺寸，有的是标注值与实际值不等，这样的尺寸有时会带来麻烦，下面的程序可以把
) @# R7 K) f/ s标注值与实际值不等的尺寸指出来，用“150号颜色”显示它。
(defun C:CHDIM()
$ s, R5 u3 n3 r% e& G(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
: u9 _( Y4 E' b$ W3 G+ P(setq N (- (sslength ssl) 1))
6 H2 Q7 B- S& m2 f  f(setq test 0)
(while (<= test  N )
1 o2 q' A3 |  M(setq DIMENSION (ENTGET (ssname ssl test)))
" `: [& H. x* W& G  f(setq Dimval (cdr (assoc '1 DIMENSION)))
(if (/= Dimval "")
(progn
(setq len (strlen Dimval))
(setq test2 1)
% X/ b7 {* l* N. ~1 j/ T( \(setq key 0)
+ C% ~/ `8 K' L' D7 G7 V(while (<= test2  (- len 1))
6 u( y8 u, Q# }: g7 l1 \(if (= (substr Dimval test2 2) "<>")(setq key 1))
(setq test2 (+ 1 test2))
/ Y2 N0 S0 X$ X/ Q: p)
(if (= key 1)
(progn
(setq SS NIL)
5 {* V$ F, V7 s(setq ss (ssadd))
9 c2 W# D2 w0 T- F) H(setq DIMENSION (ssname ssl test))
$ e; y/ [) s  x; }) H(ssadd DIMENSION SS)
  o5 U8 r; ^$ k+ \(command "change" ss "" "p" "c" "150" "")
# l0 s+ J! A! R1 }$ E5 ^)
5 e: G: Y6 Z. H; ?)
; r; l3 }& f, {)
)
(setq test (+ 1 test))
+ }" B+ R4 f" |)
, [) ~- z, p) ^% U4 u! x" `)