怎么没有二次开发的？

ZWX168

比如比例问题，图纸比例不是1：1，单行文字，多行文字的字高要改变，表注箭头、字高要改变，画图中途改变比例，所有的要改变样式吗？
* L% _, I# k, U  S6 K9 i有没有一个小程序一次搞定？

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：BL，按提示Scale factor:输入值，即可改变全部文字的字高
* \$ [' L7 N# v  y注意：标题块、图框最好作成图块，不然它们中的字字高也变了！！！！！！！！

(defun c:bl()
/ ^8 k+ u! v9 V. s/ e! q(setq val (getreal "Scale factor: "))
- u- X4 y# q2 e* }: Y, W;;默认文字字高4.0mm
. j( [" a" `5 P( y(setq high (* 4 val))
: p6 c1 j' `6 _6 ?/ r- a' q(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
, ]+ @. S9 c  ]  E) e  W' g9 G3 `(setq N (- (sslength ssl) 1))
(setq test 0)
! ]. c9 r8 `3 O7 I$ {(while (<= test  N )
& K2 z+ \1 k5 y) A, E7 R4 D6 w  e(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
(entmod DIMENSION)
( |# E/ G- Y, \. B% m* k/ X9 ^(setq test (+ 1 test))
)
(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
(setq N (- (sslength ssl) 1))
(setq test 0)
9 @  b- w* L1 Y& N: U8 q* Y% j(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
(entmod DIMENSION)
! Q+ }9 x: B" _# W& f(setq test (+ 1 test))
/ t! Q5 }: w1 T)
2 V7 ^: ], y% l$ g3 {6 y& U7 B)

cad

确实比较少。原来论坛有相关版块的，因为参与的人少，撤掉了。现在作为一个分类
6 S7 {8 D6 Q5 A: Whttp://www.askcad.com/bbs/forumd ... r=type&typeid=4

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：DIMBL，按提示Scale factor:输入值，即可改变全部标注文字的字高、箭头的大小。

* D7 b( v% i8 {2 R8 L0 ~1 D$ e# n(defun cIMbl()
(setq val (getreal "Scale factor: "))
6 Z. ~6 W) w: |) A: M+ Z1 I$ S6 C$ y/ n(setvar "DIMSCALE" val)
4 S2 s# K/ y8 s* w3 o(setvar "DIMASZ" 2)
/ z% z* o1 q! M4 q3 u(setvar "DIMTXT" 3.5)
(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(command "dim" "update" ssl "" "exit")
) I+ D' ?4 J+ N& K(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
' |8 y$ b; A" b. S/ s6 U(command "dim" "update" ssl "" "exit")
' R* y# n! D+ T)

ZWX168

8 ]) z: ]5 ~4 A. n9 R. k8 Y7 B剖面线由于比例不统一，有的太密，有的太稀。下面的程序可以把全部剖面线比例统一。

(defun c:HCbl()
( N' Q/ g/ Q. \# E6 [( f: e, V1 g(setq val (getreal "Scale factor: "))
: \- ~6 c" ~! k2 b4 B8 x(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
' v- H9 j9 |3 b- N5 W& R(setq N (- (sslength ssl) 1))
& H5 u3 `* K' |; S# W(setq test 0)
) ]& J& U' s. `0 R. h(while (<= test  N )
(setq SS NIL)
# w- r! ^; s' z3 B, o" {/ Y(setq ss (ssadd))
(ssadd (ssname ssl test) SS)
* ^' e* ^9 t- ~, i# {4 B0 ~(command "-hatchedit" ss "" "" val "")
  e3 R! m5 T# a(setq test (+ 1 test))
)
* t$ T# k* @7 })
2 e* N* Y2 g) j  X
砖要抛没了！！！！！！！
玉还不出来吗？
& l* N; f# N3 ^& c" F4 e
:'(

ZWX168

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

(defun cSbl()
(setq  DIMENSION (entget (car (entsel "lease choose an object:" ))))
0 Y9 B5 i: o; R! |(setq val (getreal "New linetype Scale : "))
(setq TEXT (cdr (assoc '8 DIMENSION)))
, ]6 c2 e4 C4 l! m3 v! R(setq ssl (ssget "X" (list (cons 8 TEXT))))
# d, a# M2 h3 x" `(command "ChPROP" ssl "" "S"  val "")
; Y6 e* p. @. ]+ E0 ]1 K)

ZWX168

有的时候，打剖面线，有些中心线、虚线、双点划线、序号指引线捣乱，要多选几个剖面区域，下面的程序可以把那些捣乱的线所在的图层冻结。
) W7 M) l; X* U) `* G1 e) e
- i' W/ G" C+ E! N8 f(defun c:FreezeMe()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
- t9 u2 _0 [1 O: l5 e  N(setq TEXT (cdr (assoc '8 DIMENSION)))
6 P# H& S$ b1 A8 x(setq Cname (getvar "clayer"))
(if  (/= Cname TEXT)
(command "layer" "F" TEXT "")
(progn
2 S6 @2 ?7 ^: e$ {5 T. |+ G& m(setq templist (tblnext "LAYER" T))
4 E0 `3 w5 ?  a1 F  k/ c; t6 Z(while templist
(setq name (cdr (assoc 2 templist)))
(if  (/= name TEXT)
(progn
(setvar "clayer" name)
# O) S  ^, n/ I3 l8 J7 W(command "layer" "F" TEXT "")
3 c9 b6 E4 T4 ], j5 `! ]/ e(setq templist nil)
9 A( s1 ]3 m$ C)
, z* C8 l9 k8 g' h! H(setq templist (tblnext "LAYER"))
)
)
0 t+ H) \/ Z, U' m/ L  W)
6 G4 f& q* P4 ^2 }0 n3 A; h% o1 W)
)

ZWX168

这个程序是楼上的反向选择，冻结所选实体所在图层以外的全部图层
1 J3 D" B' i. T5 O2 ?
& c1 {1 j! r* R* ]( O(defun c:FreezeOther()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
  E4 o& t; a/ o(setq TEXT (cdr (assoc '8 DIMENSION)))
(setvar "clayer" TEXT)
(setq Cname (getvar "clayer"))
  O" i8 \$ X& |7 A+ i; a(command "layer" "F" TEXT "")
(setq templist (tblnext "LAYER" T))
% V& Z' I# s( b8 @7 _(while templist
(setq name (cdr (assoc 2 templist)))
5 ^( T* A8 L: U  x7 I) ](if  (/= name TEXT) (command "layer" "F" name ""))
(setq templist (tblnext "LAYER"))
0 u; t8 Q$ v* O6 i- _! i4 e)
  w7 A7 N, O- R7 [0 t)

ZWX168

解冻全部图层

(defun c:unFreezeAll()
(setq templist (tblnext "LAYER" T))
(while templist
- h5 x6 e( \: {(setq name (cdr (assoc 2 templist)))
# N* P% e) z7 `4 C(command "layer" "T" name "")
) K- Z! L9 B* q8 X4 [(setq templist (tblnext "LAYER"))
, i/ ~5 |4 f# c9 {1 A! L)
(command "_regenall")
7 n" d  G. M( w& c, `)

cad

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

ZWX168

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

! @9 O& o- {+ ~! u0 A. F(defun C:hath()
(setq  DIMENSION  (car (entsel)))
(setq SSL NIL)
(setq ssL (ssadd))
! g- `2 w- A& e2 J* e: Y(ssadd DIMENSION SSL)
(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
(if (<= no 3)
6 k" ?) n4 }; a9 l- U, b- T(progn
(if (= no 1)
(progn
(setq l1 (length DIMENSION))
. E+ \6 Z5 i! [( c0 X(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(command "-bhatch" p1 "")
(command "_erase" SSL "")
, E) k$ a7 }  B  s/ z5 K. k))
(if (= no 2)
(progn
(setq l1 (length DIMENSION))
* J( ~+ i2 t5 t(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(command "-bhatch" p1 p2 "")
: L8 M& `- }- u' h(command "_erase" SSL "")
))
7 z4 X/ J9 `  y7 @(if (= no 3)
(progn
(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
% K- W6 K& L3 S3 X/ H* o(setq p3 (cdr (nth (- l1 3) DIMENSION)))
, }" Q" g- r+ C0 {* U+ L. ?(command "-bhatch" p1 p2 p3 "")
- G& T' }$ |) N+ K  [(command "_erase" SSL "")
/ e  \( C. w! W& N! t7 e))
- M/ F* l( f5 m1 M))
(if (> no 3)(prompt "请选择简单图形！"))
0 M$ O% P/ Y+ q8 o% {- _& j* M7 l- V)

ZWX168

楼上的程序“修复”的剖面线没有继承原来的属性。
更正以下，没有继承图层属性。也没有必要。
: m  n$ z  c/ D; |: s. y1 h2 g
(defun C:hath()
' i( v6 u9 h- K; J6 Q. Q; ^(setq  DIMENSION  (car (entsel)))
(setq SSL NIL)
(setq ssL (ssadd))
(ssadd DIMENSION SSL)
: {% o# T: D. l" o6 T(setq  DIMENSION (entget DIMENSION))
3 N4 D( y6 S3 T5 f(setq no (cdr (assoc '98 DIMENSION)))
- d. G# `" ]0 G" j(setq name (cdr (assoc '2 DIMENSION)))
(setq Scale (cdr (assoc '41 DIMENSION)))
9 ^+ i2 m# X0 H, z. b' \/ F(setq angle (cdr (assoc '52 DIMENSION)))
(setq angle (angtos  angle 0 0))
(if (<= no 3)
/ L* N. }8 n+ ?3 P* H- q" G. x(progn
(if (= no 1)
(progn
: s( e4 o+ z4 L- W, X1 B(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
: s, |7 }7 L3 ^1 H7 b; E(command "-bhatch" "P"  name Scale angle p1"")
(command "_erase" SSL "")
))
* g- j( T6 l" I9 V4 D1 K(if (= no 2)
' y) [* ~  P7 S; v' k(progn
% \1 ?- u1 Y+ `5 Z(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1 p2 "")
+ F4 q" [- g- k  Q- J(command "_erase" SSL "")
& e! G5 ]3 r7 C: [: N))
(if (= no 3)
' i9 c5 _, ]( m7 W5 e5 ~- s. O1 b(progn
(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
$ Y% ^( m( b  g: U. a(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(setq p3 (cdr (nth (- l1 3) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1 p2 p3 "")
(command "_erase" SSL "")
))
' y0 }3 g" ~/ g" k))
(if (> no 3)(prompt "请选择简单图形！"))
* A' o: p( l' T2 V/ u)

ZWX168

习惯上CAD画图要分若干个图层，例如："1文字"、"2标注"、"3剖面"等，下面的程序可以把不同分类的实体分别放到各自的图层中，“各就各位！”
$ U" i+ u2 @6 \(defun c:movelayer ()
(setq layname "1文字")
(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
: W" X8 O) I( i9 N: r' q(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
) G9 z! \; b* m8 s(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq layname "2标注")
8 [5 \: p# c, v  M' e(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
) w4 @8 D6 N# r0 [5 e(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
- D6 N9 R; q, l7 A; U' L(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
- N. g% q* \7 ?6 O1 ]) D3 d$ b7 G$ `(setq layname "3剖面")
(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
)

ZWX168

下面的程序可以根据选择的对象显示不同的对话框。
前提是确定已经加载了ddchprop.LSP和  ddmodify.LSP
% |5 M+ ]6 g( n+ V% A(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddchprop")
(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddmodify")


, O0 ~$ f, k* l- Q' M3 ?) A0 A+ K/ T
(defun C:ai_propchk()
(setq SSL (SSGET))
(IF (= (sslength ssL) 1)
# Z3 N+ ]* k7 X# T% O! G(progn
2 Z6 t: ?* p, C/ T* p0 l. P1 q) A(setq  DIMENSION (entget (ssname ssL 0)))
- x5 [2 @6 F- g! Z( h3 u(setq TEXT (cdr (assoc '0 DIMENSION)))
1 [: O0 v  X7 [9 |7 G(setq set 0)
" i" @! E$ l7 u7 X5 s% [(if (= TEXT  "TEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
(if (= TEXT  "MTEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
(if (= TEXT  "DIMENSION") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
: g# Z" N2 ^. d1 Y(if (= TEXT  "HATCH") (progn (COMMAND "_hatchedit" SSL) (setq set 1)))
, k& t. I7 x+ f$ p(if (= TEXT  "INSERT") (progn (COMMAND "_ddatte" SSL) (setq set 1)))
(if (= set 0) (ddmodify (ssname ssL 0)))
1 x; E4 C3 k: c9 r3 D, z)
( S8 d3 H, e  V; o)
* z- @. b( J9 T" p/ W: z(IF (> (sslength ssL) 1) (ddchprop ssl))
)

ZWX168

图纸中标注的尺寸，有的是标注值与实际值不等，这样的尺寸有时会带来麻烦，下面的程序可以把
2 g* s4 c/ H! A* O) X6 F: P标注值与实际值不等的尺寸指出来，用“150号颜色”显示它。
* A% j* D2 c+ L4 t( R! p(defun C:CHDIM()
(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
(setq Dimval (cdr (assoc '1 DIMENSION)))
. |# K9 D2 f' I* X! `8 W1 z(if (/= Dimval "")
5 C# @0 ^$ L# ~1 _/ M/ b- M(progn
(setq len (strlen Dimval))
(setq test2 1)
(setq key 0)
0 e4 a- a* W/ h" m( k3 _(while (<= test2  (- len 1))
(if (= (substr Dimval test2 2) "<>")(setq key 1))
(setq test2 (+ 1 test2))
; R" y0 b  k/ L3 o0 c)
) {8 _" U+ I6 u; d! k# [& ]6 h9 c1 V7 d(if (= key 1)
* k  t1 n7 n5 a+ k+ Z* r(progn
(setq SS NIL)
; o3 E  L% T; _+ }(setq ss (ssadd))
(setq DIMENSION (ssname ssl test))
(ssadd DIMENSION SS)
, o2 _& O: U2 B) S0 X& d( Y5 R(command "change" ss "" "p" "c" "150" "")
)
3 x7 B3 h  A, C)
# f4 X4 U( S5 Q5 p) T& Q)
4 m; w4 e$ X9 q( P3 Z( m)
(setq test (+ 1 test))
# W% `2 a1 p# R)
)