怎么没有二次开发的？

ZWX168

比如比例问题，图纸比例不是1：1，单行文字，多行文字的字高要改变，表注箭头、字高要改变，画图中途改变比例，所有的要改变样式吗？
/ V. E2 m8 q& X& l7 ^  y; I有没有一个小程序一次搞定？

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：BL，按提示Scale factor:输入值，即可改变全部文字的字高
8 ^5 j2 i7 G. o. i; @: L注意：标题块、图框最好作成图块，不然它们中的字字高也变了！！！！！！！！

(defun c:bl()
(setq val (getreal "Scale factor: "))
;;默认文字字高4.0mm
(setq high (* 4 val))
(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
(setq N (- (sslength ssl) 1))
(setq test 0)
% z  n% H/ X% M5 `9 P5 _0 A(while (<= test  N )
0 }; F! I5 K7 s(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
(entmod DIMENSION)
7 T' Q! _) z8 E  }# O(setq test (+ 1 test))
; U' q1 Y7 k1 x5 E" |  I)
(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
3 W4 b6 R7 p9 S0 d! x. l7 ~, m" o4 O: C; o(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
% j. k) n4 B6 T5 S3 r( \1 e(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
$ y0 u; K/ c! U' S(entmod DIMENSION)
. y( L1 Y- E- j" C- ~(setq test (+ 1 test))
)
+ y% \, x' K( ?+ k6 L1 r2 [)

cad

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

ZWX168

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

(defun cIMbl()
(setq val (getreal "Scale factor: "))
(setvar "DIMSCALE" val)
(setvar "DIMASZ" 2)
(setvar "DIMTXT" 3.5)
6 x' b7 y2 m7 ]" i9 N7 v(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
8 \- Z: [) t; Y(command "dim" "update" ssl "" "exit")
6 h( k/ E. W/ ?* Q) A& b(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
(command "dim" "update" ssl "" "exit")
, I/ }" A3 p. M)

ZWX168

剖面线由于比例不统一，有的太密，有的太稀。下面的程序可以把全部剖面线比例统一。

(defun c:HCbl()
(setq val (getreal "Scale factor: "))
(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
  _+ a' K4 z1 s- _(setq N (- (sslength ssl) 1))
( P- C# e  G6 T- i8 S(setq test 0)
(while (<= test  N )
& @6 Y. R7 S: e) Q/ \(setq SS NIL)
(setq ss (ssadd))
(ssadd (ssname ssl test) SS)
(command "-hatchedit" ss "" "" val "")
(setq test (+ 1 test))
" m6 T2 ?2 Y! m& o( a)
6 p# R& B8 K7 J$ [' _$ ]- h)

, x% C) b$ Y/ S砖要抛没了！！！！！！！
0 R: J2 J9 s8 M! P玉还不出来吗？

1 R4 n* ^+ m- d! c# r3 r9 m7 m :'(

ZWX168

我做图时习惯把虚线、点划线、双点划线分别放在单独的图层，由于粘贴的图形导致同一线形的线形比例不同，很难看，下面的程序可以把选中的线所在图层的全部图线的线形比例统一
* ]+ M( }, ^- K: b7 d, O/ B. w
# m/ M5 M# t/ k(defun cSbl()
* x2 @+ D, v' y* \(setq  DIMENSION (entget (car (entsel "lease choose an object:" ))))
* W; F' q: o; V9 N; t& T(setq val (getreal "New linetype Scale : "))
3 c* ^% `; W' C( b" C) e. k5 d(setq TEXT (cdr (assoc '8 DIMENSION)))
(setq ssl (ssget "X" (list (cons 8 TEXT))))
(command "ChPROP" ssl "" "S"  val "")
7 C( J! m# T: h)

ZWX168

有的时候，打剖面线，有些中心线、虚线、双点划线、序号指引线捣乱，要多选几个剖面区域，下面的程序可以把那些捣乱的线所在的图层冻结。
2 z. ~+ W: e& o
2 G6 k8 i. W4 `) y. N. l& N  D2 r(defun c:FreezeMe()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
(setq TEXT (cdr (assoc '8 DIMENSION)))
(setq Cname (getvar "clayer"))
(if  (/= Cname TEXT)
& ]! U( P6 k: ?1 @9 N  `9 l(command "layer" "F" TEXT "")
: u% Z! h+ S0 ^" ?2 N# L(progn
0 E% T+ m7 D0 i! B  t, b(setq templist (tblnext "LAYER" T))
(while templist
+ N& p2 y; y# g' `/ a(setq name (cdr (assoc 2 templist)))
  I6 M7 i5 M+ w* @* V(if  (/= name TEXT)
(progn
% ^/ ^; v2 o0 }(setvar "clayer" name)
(command "layer" "F" TEXT "")
(setq templist nil)
)
(setq templist (tblnext "LAYER"))
& C) R( q/ k$ t1 ~7 D5 Q) e' m% l)
)
)
/ }9 Q% h3 c! D2 F$ n)
)

ZWX168

这个程序是楼上的反向选择，冻结所选实体所在图层以外的全部图层
# j9 s  Q0 ^% X. |% O
(defun c:FreezeOther()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
8 }0 \2 F: E1 v! e' E, d(setq TEXT (cdr (assoc '8 DIMENSION)))
(setvar "clayer" TEXT)
$ F# i; a" a* q. g/ E5 X( Y(setq Cname (getvar "clayer"))
(command "layer" "F" TEXT "")
(setq templist (tblnext "LAYER" T))
& y: h3 t8 ?! G$ ^4 [5 S  }; Y- \1 C(while templist
" |# B  B( s. V2 c, d& M$ ~(setq name (cdr (assoc 2 templist)))
! j2 b1 H7 p9 q2 t- P( M(if  (/= name TEXT) (command "layer" "F" name ""))
(setq templist (tblnext "LAYER"))
)
)

ZWX168

解冻全部图层
* X' S0 j2 D$ y' v& ]& j. A+ C" y
, G0 c; o# L8 w; I(defun c:unFreezeAll()
(setq templist (tblnext "LAYER" T))
' n4 y( K6 [" }# N2 `(while templist
: y; w# S$ f& F* m! g- B  A" O+ p& y: O(setq name (cdr (assoc 2 templist)))
/ `6 z$ T: I. }2 T8 m2 V2 ^) V  W(command "layer" "T" name "")
(setq templist (tblnext "LAYER"))
)
9 z) P0 ~- C- _3 Q( _(command "_regenall")
2 G' D$ b0 Q' ?* o)

cad

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

ZWX168

重画剖面线：如果剖面线的边界发生变化，如拉伸后剖面线没有与边界同步调整，下面的程序可以“修复剖面线”。只对简单的图形有效（《=3 个分开的图形）。当然图形得是封闭的，原来的剖面线位置变化不大。
. R0 N2 N5 }+ k1 M% }/ Z6 b
(defun C:hath()
(setq  DIMENSION  (car (entsel)))
(setq SSL NIL)
2 }8 Q) O$ P$ e& q8 K0 Y4 E(setq ssL (ssadd))
3 |; z! n8 D, z! }' a1 n- U2 z8 l5 p(ssadd DIMENSION SSL)
(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
(if (<= no 3)
(progn
(if (= no 1)
(progn
(setq l1 (length DIMENSION))
7 a( `" y6 ?/ V; I6 j(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(command "-bhatch" p1 "")
, V' t8 B! l1 i- `. L% g  K/ M(command "_erase" SSL "")
1 g( @) ]5 M6 w8 t. m# }) L: U))
: Z6 j5 _- e% p( d(if (= no 2)
* p$ A' i2 }  e0 B) Y6 X& J  g0 B(progn
(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
! F* s# ?) j( v& \/ _(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(command "-bhatch" p1 p2 "")
, t: @/ l% C) ], V(command "_erase" SSL "")
& J1 U+ E& }) J0 F% U% q))
6 H) V, o$ \+ h/ r(if (= no 3)
(progn
0 h5 K; W% F4 f# X6 E+ m3 o(setq l1 (length DIMENSION))
, G6 p. ?- W6 p5 E8 L$ c! F3 }" `. b/ g(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(setq p3 (cdr (nth (- l1 3) DIMENSION)))
(command "-bhatch" p1 p2 p3 "")
3 i" F9 C2 [0 m  X# y(command "_erase" SSL "")
))
( Y) y) q- i: C) E# d- E1 C))
. O9 \2 @1 c0 M) ]# h: z4 d- u(if (> no 3)(prompt "请选择简单图形！"))
)

ZWX168

楼上的程序“修复”的剖面线没有继承原来的属性。
更正以下，没有继承图层属性。也没有必要。
5 w+ ~1 p* t6 v2 ?- H
0 z+ ?* k  K1 B6 |- Q! B" ~(defun C:hath()
(setq  DIMENSION  (car (entsel)))
(setq SSL NIL)
; |1 K. r( D& E. y% `(setq ssL (ssadd))
(ssadd DIMENSION SSL)
(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
9 {4 P0 j8 {& w, i- n% g7 f(setq name (cdr (assoc '2 DIMENSION)))
" A0 R4 I/ t6 ^/ O: n(setq Scale (cdr (assoc '41 DIMENSION)))
(setq angle (cdr (assoc '52 DIMENSION)))
4 V" x8 a4 I$ E: T) H" Y; t8 c# _% H(setq angle (angtos  angle 0 0))
(if (<= no 3)
(progn
(if (= no 1)
& ]. k5 l& h6 E+ X: U' X% m(progn
(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1"")
; @6 E+ ^% U9 Q; W& E: W2 t1 H3 K(command "_erase" SSL "")
))
(if (= no 2)
& Y& r# i+ ~9 o(progn
: w! j; j% ^* X  d: }. `% P. E  C(setq l1 (length DIMENSION))
; Z8 k  {8 |3 z( [% N" o(setq p1 (cdr (nth (- l1 1) DIMENSION)))
4 k  ?2 E) s, @* t  T; |2 i/ z(setq p2 (cdr (nth (- l1 2) DIMENSION)))
$ r$ I9 y6 `8 F2 H! s$ F7 ?(command "-bhatch" "P"  name Scale angle p1 p2 "")
# Q! o: P7 k4 h1 J(command "_erase" SSL "")
))
) D% C) }( P; R/ ^3 _& S5 a(if (= no 3)
1 u8 S* ?7 e+ w(progn
: h" N; }5 r' m; `: W/ G* c(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
9 A6 y7 ~: \) @(setq p3 (cdr (nth (- l1 3) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1 p2 p3 "")
& z. ^9 F* L' X8 D& _(command "_erase" SSL "")
8 b5 N. s  V& `' v1 i))
' S. d/ z# M' Q4 E, B" U0 f))
9 q: \3 H! `  b5 |, T8 X(if (> no 3)(prompt "请选择简单图形！"))
)

ZWX168

习惯上CAD画图要分若干个图层，例如："1文字"、"2标注"、"3剖面"等，下面的程序可以把不同分类的实体分别放到各自的图层中，“各就各位！”
: i: Q0 d7 A% }3 Q(defun c:movelayer ()
+ x8 x! ?0 ~3 u1 R8 H6 }9 Y(setq layname "1文字")
(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
& J; d$ ]2 e, z8 z; B# p/ W  W9 Y& o(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
4 c) [" Q6 {2 }2 }) e. \5 d8 B7 ^(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq layname "2标注")
(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
. |/ E: P* ~) B. R' C& s  r(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq layname "3剖面")
- {1 P' O+ ~: F& |3 p(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
% T. D/ G9 X( B7 _3 M# Q) M" @: {8 k)

ZWX168

下面的程序可以根据选择的对象显示不同的对话框。
前提是确定已经加载了ddchprop.LSP和  ddmodify.LSP
' z6 y8 N% t: F% J: J3 m(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddchprop")
, D1 E. d9 @" `8 m' ?# @(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddmodify")
' m3 Y" H! X5 g# ~+ G
4 ~% A6 Y# x: u0 d/ y$ q

(defun C:ai_propchk()
( ^6 f* ]5 J. E% W/ G0 Y8 q(setq SSL (SSGET))
(IF (= (sslength ssL) 1)
(progn
(setq  DIMENSION (entget (ssname ssL 0)))
(setq TEXT (cdr (assoc '0 DIMENSION)))
- O) J! R) E6 ?) c(setq set 0)
/ L7 x8 e7 b/ S4 t+ Z(if (= TEXT  "TEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
7 \' i  j3 d; G+ }  [, |& M(if (= TEXT  "MTEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
: f. r6 n) p9 R4 r- z(if (= TEXT  "DIMENSION") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
: w( v2 |' Z2 t(if (= TEXT  "HATCH") (progn (COMMAND "_hatchedit" SSL) (setq set 1)))
(if (= TEXT  "INSERT") (progn (COMMAND "_ddatte" SSL) (setq set 1)))
6 `" k  V! S- l) ~1 ^' c(if (= set 0) (ddmodify (ssname ssL 0)))
)
. V* v) t3 d5 O" ?+ k)
(IF (> (sslength ssL) 1) (ddchprop ssl))
)

ZWX168

图纸中标注的尺寸，有的是标注值与实际值不等，这样的尺寸有时会带来麻烦，下面的程序可以把
标注值与实际值不等的尺寸指出来，用“150号颜色”显示它。
( O% _0 Y' {3 T# E(defun C:CHDIM()
( ^1 ^  B- a; Z, i* o3 s(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(setq N (- (sslength ssl) 1))
2 [3 S1 Z  W6 _( {# z(setq test 0)
8 _6 o& {6 s8 _6 K0 c& Q(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
(setq Dimval (cdr (assoc '1 DIMENSION)))
/ I. Y6 y- V7 _1 l4 r" I(if (/= Dimval "")
(progn
2 [& R9 D# J5 {7 L# r. S$ J(setq len (strlen Dimval))
(setq test2 1)
9 r; P0 F6 o6 @9 g$ r, r(setq key 0)
( v: m* H; p; B: c% a! I/ G  r(while (<= test2  (- len 1))
(if (= (substr Dimval test2 2) "<>")(setq key 1))
: E; I9 ~2 c; j( I0 o, l(setq test2 (+ 1 test2))
; d# o- d* V6 E6 E# `: a% B)
(if (= key 1)
(progn
(setq SS NIL)
(setq ss (ssadd))
7 n  F! Z' q$ [(setq DIMENSION (ssname ssl test))
: ?8 p: r0 T6 W, H" \9 y+ R(ssadd DIMENSION SS)
(command "change" ss "" "p" "c" "150" "")
)
/ p& i; v% H( Z: n( \% m)
)
9 M4 Z/ b& e/ i9 j- I)
1 }- Z% n6 W+ [; o1 r& w(setq test (+ 1 test))
: X! v- ~7 t: Q% s5 a3 j: M! _)
7 r8 X! ?5 t2 f5 g)