怎么没有二次开发的？

ZWX168

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

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：BL，按提示Scale factor:输入值，即可改变全部文字的字高
, i! Z' i- X* B! u; i注意：标题块、图框最好作成图块，不然它们中的字字高也变了！！！！！！！！

1 V& s4 D* f. h( I. Q4 ?(defun c:bl()
(setq val (getreal "Scale factor: "))
; S2 O, l4 o3 X5 M3 |;;默认文字字高4.0mm
(setq high (* 4 val))
(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
% f, w9 x! {- e6 z/ S7 a% d(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
(entmod DIMENSION)
(setq test (+ 1 test))
9 \# g3 B+ c+ g1 Z. b! e)
(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
4 A! s, Y4 t4 m! [! ~2 C; I+ a' M(setq N (- (sslength ssl) 1))
( }  I( E+ \( A+ W; p(setq test 0)
(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
# h7 g% O5 f- |8 S) C4 z+ S(entmod DIMENSION)
# M3 F) O2 }, T6 N! ?5 q% @$ ~(setq test (+ 1 test))
)
)

cad

确实比较少。原来论坛有相关版块的，因为参与的人少，撤掉了。现在作为一个分类
5 x; _  O. y" i, L8 A, E* Hhttp://www.askcad.com/bbs/forumd ... r=type&typeid=4

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：DIMBL，按提示Scale factor:输入值，即可改变全部标注文字的字高、箭头的大小。
) k5 o  I' L) E
(defun cIMbl()
+ V, h. Z* ^/ G4 s(setq val (getreal "Scale factor: "))
% o6 a. |1 J& s/ x$ L% j8 H  g9 }(setvar "DIMSCALE" val)
2 _  G4 D+ |' ~' r" ?% a(setvar "DIMASZ" 2)
(setvar "DIMTXT" 3.5)
(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(command "dim" "update" ssl "" "exit")
(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
1 D7 o5 J% |& Y% p+ h& z; Y(command "dim" "update" ssl "" "exit")
)

ZWX168

2 I1 E4 H) s- F$ z" s& D, L4 }  J剖面线由于比例不统一，有的太密，有的太稀。下面的程序可以把全部剖面线比例统一。
/ A0 v' b2 _3 w: _
(defun c:HCbl()
% Q6 V) y" Y  ~. ~3 s0 i. D, ?, h5 L(setq val (getreal "Scale factor: "))
(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
(setq N (- (sslength ssl) 1))
& g6 M4 J- H! _2 I5 B1 F(setq test 0)
(while (<= test  N )
9 |3 l1 b% X8 {! {2 C* ~( q% c(setq SS NIL)
(setq ss (ssadd))
(ssadd (ssname ssl test) SS)
4 K' @* @- S4 e  n7 j  b8 t(command "-hatchedit" ss "" "" val "")
7 H3 R2 V* o. ]* K( y; C* J$ I- o(setq test (+ 1 test))
)
4 R6 R6 G; V* Q; V3 e) ])

砖要抛没了！！！！！！！
( }* H9 S) q  B* W/ V: X* A0 W玉还不出来吗？

( J* l/ @6 ]/ ]) p :'(

ZWX168

我做图时习惯把虚线、点划线、双点划线分别放在单独的图层，由于粘贴的图形导致同一线形的线形比例不同，很难看，下面的程序可以把选中的线所在图层的全部图线的线形比例统一
' c! d8 R  A- w. H' z  E$ p
) B$ S3 I# [2 i* {1 E9 l+ r(defun cSbl()
(setq  DIMENSION (entget (car (entsel "lease choose an object:" ))))
(setq val (getreal "New linetype Scale : "))
(setq TEXT (cdr (assoc '8 DIMENSION)))
(setq ssl (ssget "X" (list (cons 8 TEXT))))
(command "ChPROP" ssl "" "S"  val "")
; N. f" h9 K( L) M)

ZWX168

有的时候，打剖面线，有些中心线、虚线、双点划线、序号指引线捣乱，要多选几个剖面区域，下面的程序可以把那些捣乱的线所在的图层冻结。
/ h& `! w) {2 l( ^
2 T3 e& o7 a) f$ }# n(defun c:FreezeMe()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
(setq TEXT (cdr (assoc '8 DIMENSION)))
3 T: f: e) Y1 V(setq Cname (getvar "clayer"))
/ @4 n, G  s, x& v2 B* Y9 W5 H(if  (/= Cname TEXT)
(command "layer" "F" TEXT "")
' a! Z2 `4 A! D: [8 S: T(progn
(setq templist (tblnext "LAYER" T))
(while templist
(setq name (cdr (assoc 2 templist)))
(if  (/= name TEXT)
(progn
, L% f' I% o- L, o6 P! o' a(setvar "clayer" name)
/ a& z+ I; _5 M% R) a(command "layer" "F" TEXT "")
1 a9 Q% ^: S# d( o* c* W(setq templist nil)
" O  \! `0 u" A5 M! `! B)
(setq templist (tblnext "LAYER"))
% w% i+ m: j' J5 q/ B' d)
)
)
# p4 R9 |/ [  A3 J) A+ ^% e)
" u- G' [7 M' ?6 K)

ZWX168

这个程序是楼上的反向选择，冻结所选实体所在图层以外的全部图层
8 k8 \0 G3 t9 @$ T! i, j
(defun c:FreezeOther()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
(setq TEXT (cdr (assoc '8 DIMENSION)))
(setvar "clayer" TEXT)
(setq Cname (getvar "clayer"))
(command "layer" "F" TEXT "")
$ m: {9 x9 s  X$ q(setq templist (tblnext "LAYER" T))
4 r$ w8 h) S. B- B4 i; a. b7 ]+ Y(while templist
! d5 R  X: Y/ m4 ], R3 G5 R(setq name (cdr (assoc 2 templist)))
7 Q2 |+ Q* J0 _; s5 b(if  (/= name TEXT) (command "layer" "F" name ""))
" l: Y( l# `: o(setq templist (tblnext "LAYER"))
)
)

ZWX168

解冻全部图层

(defun c:unFreezeAll()
2 c! J4 P' x1 Z) j" U' N+ z" H(setq templist (tblnext "LAYER" T))
# J) }2 @6 |( z+ y, l6 G( I(while templist
(setq name (cdr (assoc 2 templist)))
(command "layer" "T" name "")
(setq templist (tblnext "LAYER"))
$ `  [! z; n: Q& P- b)
(command "_regenall")
)

cad

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

ZWX168

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

4 B7 I" @) C6 t( [(defun C:hath()
(setq  DIMENSION  (car (entsel)))
- B! n' \& E& m7 k(setq SSL NIL)
(setq ssL (ssadd))
(ssadd DIMENSION SSL)
8 Y, o4 O' b0 z+ N, D8 f(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
(if (<= no 3)
(progn
. K! E" ]2 T- Z, j(if (= no 1)
! \$ L9 ^+ D5 m(progn
% L& ^0 A: g0 B0 v4 o* k; |(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(command "-bhatch" p1 "")
4 M5 I7 d: u: H6 z1 i7 z2 W(command "_erase" SSL "")
+ _! W: J, B4 @0 a' D0 I. }))
(if (= no 2)
- ]/ T2 V3 D/ Y2 O(progn
1 q: p! m. W" R* M8 x(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
% t* }7 u: N, f1 b(command "-bhatch" p1 p2 "")
) T, c+ Q7 Z3 _: e(command "_erase" SSL "")
))
8 y- _7 r/ Y7 K. v  K4 S(if (= no 3)
(progn
4 x: O/ L. G- y) E  C3 u(setq l1 (length DIMENSION))
6 p$ Y: V/ M9 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 "")
(command "_erase" SSL "")
. v: z  v! h" W1 x))
))
(if (> no 3)(prompt "请选择简单图形！"))
5 [% L- [" c- i9 i9 I8 W)

ZWX168

楼上的程序“修复”的剖面线没有继承原来的属性。
' L: v; L- G0 w- ?更正以下，没有继承图层属性。也没有必要。
- C: L  d! W: _& V0 p2 M8 i
(defun C:hath()
+ B2 I: A# C2 i: O( _0 i(setq  DIMENSION  (car (entsel)))
, m" z( Q1 F% }, _" i(setq SSL NIL)
(setq ssL (ssadd))
(ssadd DIMENSION SSL)
(setq  DIMENSION (entget DIMENSION))
4 |1 H8 x* F- g(setq no (cdr (assoc '98 DIMENSION)))
(setq name (cdr (assoc '2 DIMENSION)))
(setq Scale (cdr (assoc '41 DIMENSION)))
(setq angle (cdr (assoc '52 DIMENSION)))
( s1 x! O6 r5 [1 @# `(setq angle (angtos  angle 0 0))
! `1 B+ ?2 \5 A(if (<= no 3)
(progn
0 d  u" C" q+ W/ O(if (= no 1)
(progn
(setq l1 (length DIMENSION))
3 G# F" S2 N8 a. n(setq p1 (cdr (nth (- l1 1) DIMENSION)))
) H+ q8 b+ F9 m+ Q; D  h: \- F" X(command "-bhatch" "P"  name Scale angle p1"")
(command "_erase" SSL "")
))
" }- e  D: ~9 K# F(if (= no 2)
; ^6 _! X$ O& K2 w(progn
) q3 q+ u: n; C1 F8 E8 x(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 "")
1 |3 c+ }: u6 s# e1 F(command "_erase" SSL "")
))
- j  u/ d  ]* w# }, K(if (= no 3)
(progn
/ s8 y/ J, }" {# b5 r' v(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
5 G! @; t# n2 n4 {1 ~) N4 e( A9 P(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(setq p3 (cdr (nth (- l1 3) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1 p2 p3 "")
) f% S5 s% H" ]9 |" |; f(command "_erase" SSL "")
  _- r' z5 O( P' `))
0 w7 H3 S5 Z# D/ X. N))
(if (> no 3)(prompt "请选择简单图形！"))
)

ZWX168

习惯上CAD画图要分若干个图层，例如："1文字"、"2标注"、"3剖面"等，下面的程序可以把不同分类的实体分别放到各自的图层中，“各就各位！”
(defun c:movelayer ()
(setq layname "1文字")
8 R/ [; K# p5 Q7 P& D(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
; |/ l0 b1 m% @. q(setq layname "2标注")
9 J* j- S. y2 I; H! g& u- O(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
; Y# a( d( T9 i7 w( T(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
& G& h2 x) d& ]! q" S: P(setq layname "3剖面")
; `# v8 S2 |2 Z- V9 l5 B(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
" N3 g  t6 D( [  v1 Q/ C(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
3 z: E. y# \9 o% A2 s)

ZWX168

下面的程序可以根据选择的对象显示不同的对话框。
/ k% R' `& ]! e. v; J前提是确定已经加载了ddchprop.LSP和  ddmodify.LSP
8 i! O& r; e$ `  r9 Q1 d$ _% Y8 v1 l: `(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddchprop")
' v+ ]  A8 y& l% s% I5 s(load "C:\\Program Files\\AutoCAD R14\\SUPPORT\\ddmodify")

: P  a6 l. Q- u+ m8 t) }
, {/ {1 k: {4 l( L" c# f
( h4 V$ q6 ^$ b+ A4 i3 Y2 j(defun C:ai_propchk()
% a' Y2 ?+ g3 d$ Q1 o# k(setq SSL (SSGET))
(IF (= (sslength ssL) 1)
& ]+ S( I! i7 `, k  N' N( |(progn
(setq  DIMENSION (entget (ssname ssL 0)))
(setq TEXT (cdr (assoc '0 DIMENSION)))
(setq set 0)
' _/ R0 Y! Y1 \- n2 ]. E1 C7 Q(if (= TEXT  "TEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
' c( k" W" W6 h7 U(if (= TEXT  "MTEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
(if (= TEXT  "DIMENSION") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
(if (= TEXT  "HATCH") (progn (COMMAND "_hatchedit" SSL) (setq set 1)))
(if (= TEXT  "INSERT") (progn (COMMAND "_ddatte" SSL) (setq set 1)))
6 e( j2 Z; X- f(if (= set 0) (ddmodify (ssname ssL 0)))
)
0 _8 J7 a, o/ c/ e! Y)
" v$ H; A3 i/ Z( l(IF (> (sslength ssL) 1) (ddchprop ssl))
)

ZWX168

图纸中标注的尺寸，有的是标注值与实际值不等，这样的尺寸有时会带来麻烦，下面的程序可以把
; X6 X" X3 N: H  E标注值与实际值不等的尺寸指出来，用“150号颜色”显示它。
(defun C:CHDIM()
(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
8 @% i* K. x& A; J7 `: p. j% i(setq DIMENSION (ENTGET (ssname ssl test)))
! F- K" |2 }2 b- [5 [9 I(setq Dimval (cdr (assoc '1 DIMENSION)))
+ Y* \4 c$ a& \, A(if (/= Dimval "")
  T$ q" Y& h. G, g% d7 u8 m(progn
(setq len (strlen Dimval))
(setq test2 1)
3 B/ S8 H( s* u, M, p. b7 A* h(setq key 0)
(while (<= test2  (- len 1))
0 P- O5 [. \. W, |7 m$ Y! f(if (= (substr Dimval test2 2) "<>")(setq key 1))
, f3 b4 W" D5 G" A" {4 W( M8 S(setq test2 (+ 1 test2))
)
- Q" j' s" r% h# h; g1 y(if (= key 1)
2 m* S) @+ K2 p. [( b- _, R(progn
(setq SS NIL)
5 X  R1 f7 H2 t+ s) {7 B(setq ss (ssadd))
(setq DIMENSION (ssname ssl test))
(ssadd DIMENSION SS)
  R3 a; x4 y4 t% L(command "change" ss "" "p" "c" "150" "")
)
  A+ Z' T& j( R/ {; M)
  q+ G* x! [. W/ F$ @1 R% C" W! d$ X)
8 c5 k4 ^1 `% R+ L& P2 r1 h)
" d0 A  Q# O0 O* x(setq test (+ 1 test))
2 U, f# n9 p2 B)
, E* B$ P/ _1 _9 g& I3 B. e)