怎么没有二次开发的？

ZWX168

比如比例问题，图纸比例不是1：1，单行文字，多行文字的字高要改变，表注箭头、字高要改变，画图中途改变比例，所有的要改变样式吗？
& e2 H$ o: u0 v; Z) H) b有没有一个小程序一次搞定？

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：BL，按提示Scale factor:输入值，即可改变全部文字的字高
: j' c& @' Z. q0 w3 x' u3 j( s注意：标题块、图框最好作成图块，不然它们中的字字高也变了！！！！！！！！
0 [- H9 U/ I. q
(defun c:bl()
(setq val (getreal "Scale factor: "))
;;默认文字字高4.0mm
(setq high (* 4 val))
( B0 V7 \9 q+ ?9 X(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
(setq N (- (sslength ssl) 1))
(setq test 0)
/ T. \0 e- c8 }# `' {6 g" a7 n5 x8 T(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
% Z# u$ J) g8 a, N(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
  F. u1 e9 p* g4 W+ N! S2 u(entmod DIMENSION)
& I3 O! k/ z2 b6 C! w" y( K(setq test (+ 1 test))
)
/ d: H' s# F" p4 }" t% L  I$ B" t(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
& J& i, l2 H! ?% l, X* y2 x$ k(setq DIMENSION (subst (cons 40 high) (assoc 40 DIMENSION) DIMENSION ))
# x9 h9 u9 o. M6 i(entmod DIMENSION)
% u2 p/ L& h* I* \: j(setq test (+ 1 test))
6 o3 ?7 p  J% X; \# u)
)

cad

确实比较少。原来论坛有相关版块的，因为参与的人少，撤掉了。现在作为一个分类
* S, L" i' r& f$ r" I, k5 Thttp://www.askcad.com/bbs/forumd ... r=type&typeid=4

ZWX168

下面的程序放到：ACA.LSP文件中，执行命令：DIMBL，按提示Scale factor:输入值，即可改变全部标注文字的字高、箭头的大小。
5 J8 o$ |4 Q1 p! s! i( H) W0 m
(defun cIMbl()
(setq val (getreal "Scale factor: "))
3 V" j( I* O8 I: R. L2 n& Q(setvar "DIMSCALE" val)
. G) G8 o# U+ H& r(setvar "DIMASZ" 2)
' d. {6 E% s3 \(setvar "DIMTXT" 3.5)
(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
3 p/ e9 V. r. y(command "dim" "update" ssl "" "exit")
(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
(command "dim" "update" ssl "" "exit")
" I/ E# u! t$ A- })

ZWX168

* v: J9 w! x% t" i2 o  q8 W剖面线由于比例不统一，有的太密，有的太稀。下面的程序可以把全部剖面线比例统一。
7 \5 N, V: c- K* `$ Y7 [: k# Z
(defun c:HCbl()
(setq val (getreal "Scale factor: "))
+ ~' A& \" j' C/ y# C7 G(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
: ?# x# e; F& _(setq N (- (sslength ssl) 1))
(setq test 0)
(while (<= test  N )
5 m$ B. T6 [* H% ^4 K(setq SS NIL)
) @: I( @) w2 N! z* U) x* g  [9 H(setq ss (ssadd))
(ssadd (ssname ssl test) SS)
8 e( ^: s0 W; y$ ?(command "-hatchedit" ss "" "" val "")
(setq test (+ 1 test))
3 G6 |0 [7 Q# w' p( \)
)

6 S1 Y! a& o2 E5 A* [% D砖要抛没了！！！！！！！
玉还不出来吗？
% S" F7 K* f5 A' I( T+ w4 `6 w
:'(

ZWX168

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

6 k" w* e7 F9 V: R(defun cSbl()
(setq  DIMENSION (entget (car (entsel "lease choose an object:" ))))
: \4 A$ \3 b# A1 u/ K" n4 @(setq val (getreal "New linetype Scale : "))
9 B9 F6 h+ d0 D(setq TEXT (cdr (assoc '8 DIMENSION)))
, }0 o7 I/ g! [0 m; L6 T; i5 \- q(setq ssl (ssget "X" (list (cons 8 TEXT))))
(command "ChPROP" ssl "" "S"  val "")
)

ZWX168

有的时候，打剖面线，有些中心线、虚线、双点划线、序号指引线捣乱，要多选几个剖面区域，下面的程序可以把那些捣乱的线所在的图层冻结。
% T) g3 ]3 a& d5 r3 O
5 r  q3 f+ `0 S! `* x) M+ _(defun c:FreezeMe()
( X4 D+ I/ {4 x) O- r6 _(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
(setq TEXT (cdr (assoc '8 DIMENSION)))
(setq Cname (getvar "clayer"))
, ?4 }; _1 F0 f; K7 n(if  (/= Cname TEXT)
(command "layer" "F" TEXT "")
$ @7 g" x1 x/ d; V& E(progn
+ g0 V5 D* _  `$ ^(setq templist (tblnext "LAYER" T))
7 u% F/ i5 s" h(while templist
9 W9 q8 X0 `# O1 y(setq name (cdr (assoc 2 templist)))
(if  (/= name TEXT)
(progn
(setvar "clayer" name)
(command "layer" "F" TEXT "")
; L: U8 [. i# D# u$ q* u0 N8 F$ X(setq templist nil)
) B/ @8 }) I# \$ a)
(setq templist (tblnext "LAYER"))
)
* y' x( ?9 b& f6 v8 ^)
)
)
( ?7 l" i% L  L# z+ }* y)

ZWX168

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

(defun c:FreezeOther()
(setq  DIMENSION (entget (car (entsel "Please choose an object:" ))))
(setq TEXT (cdr (assoc '8 DIMENSION)))
: ]9 ]4 b8 o  }+ e! X8 q" _(setvar "clayer" TEXT)
(setq Cname (getvar "clayer"))
5 Y& f4 |( @! C(command "layer" "F" TEXT "")
) d& d: F4 Y) |5 g% N5 M- b6 Y6 A(setq templist (tblnext "LAYER" T))
: q$ Y% ?5 n  M(while templist
* d$ M7 c$ U/ S- ^; Y) {+ I(setq name (cdr (assoc 2 templist)))
6 V4 M" x8 _& }/ F1 }5 ](if  (/= name TEXT) (command "layer" "F" name ""))
(setq templist (tblnext "LAYER"))
)
/ g. ?! D) Y& Y) B: a; t)

ZWX168

解冻全部图层

  b4 \* u9 E* e$ u- x(defun c:unFreezeAll()
8 k0 T: w' Y5 k/ X& `* X(setq templist (tblnext "LAYER" T))
. \* L3 K( I& ]7 u(while templist
7 y. E9 F( R- V. [$ H& }(setq name (cdr (assoc 2 templist)))
3 V! Y8 @& h2 z9 ]' n8 }% N- {(command "layer" "T" name "")
(setq templist (tblnext "LAYER"))
)
(command "_regenall")
! o7 T: U/ _- n9 V' ~. G1 P9 y4 |)

cad

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

ZWX168

重画剖面线：如果剖面线的边界发生变化，如拉伸后剖面线没有与边界同步调整，下面的程序可以“修复剖面线”。只对简单的图形有效（《=3 个分开的图形）。当然图形得是封闭的，原来的剖面线位置变化不大。
# F; n$ O7 K2 I
(defun C:hath()
0 X: t( k' |' T9 g2 N) U(setq  DIMENSION  (car (entsel)))
(setq SSL NIL)
(setq ssL (ssadd))
/ q! }$ E/ x6 _  c( A8 X' r. L+ U; J(ssadd DIMENSION SSL)
( Y. O; I+ l0 X% C# u! w; k(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
(if (<= no 3)
3 [: V4 }" E2 J  C3 l(progn
2 F5 c; s7 h& u9 o1 z' q& v5 G(if (= no 1)
: w- o* H" ^* e; v8 [: w/ t(progn
6 k4 @" O, J7 s# x(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
) R! U: t# t5 }8 F(command "-bhatch" p1 "")
2 b$ x8 B  w1 L" x4 V(command "_erase" SSL "")
" C. v9 u: b4 Y8 E! K* \))
- I7 p) @; u/ f2 v# M2 m  d(if (= no 2)
(progn
8 U/ i. K2 ~. w0 e  N$ {# m2 x(setq l1 (length DIMENSION))
5 C. y: j: {7 ]% G( K(setq p1 (cdr (nth (- l1 1) DIMENSION)))
/ f) F; V- P6 t- R(setq p2 (cdr (nth (- l1 2) DIMENSION)))
$ L* i3 H2 U1 r& h(command "-bhatch" p1 p2 "")
(command "_erase" SSL "")
1 n( v2 ]8 f8 R7 f))
' W0 o* _  f  ~8 P# V, N(if (= no 3)
(progn
(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
, H% u. K& [7 L5 d; q(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(setq p3 (cdr (nth (- l1 3) DIMENSION)))
4 a. {9 r# e, t& t  |(command "-bhatch" p1 p2 p3 "")
; g6 \4 t# |3 n) @% A  j(command "_erase" SSL "")
/ v7 b+ g2 b( i4 X2 J))
))
(if (> no 3)(prompt "请选择简单图形！"))
)

ZWX168

楼上的程序“修复”的剖面线没有继承原来的属性。
0 T4 N4 B/ l. A" p- d更正以下，没有继承图层属性。也没有必要。

(defun C:hath()
  G9 X7 y8 }9 S" T(setq  DIMENSION  (car (entsel)))
( U% L7 K6 c& f$ f/ y8 c(setq SSL NIL)
(setq ssL (ssadd))
(ssadd DIMENSION SSL)
(setq  DIMENSION (entget DIMENSION))
(setq no (cdr (assoc '98 DIMENSION)))
( g/ s; n0 c8 o(setq name (cdr (assoc '2 DIMENSION)))
(setq Scale (cdr (assoc '41 DIMENSION)))
(setq angle (cdr (assoc '52 DIMENSION)))
(setq angle (angtos  angle 0 0))
1 @) c) [+ t% T$ e) \% L. X9 b- E(if (<= no 3)
- s; u- T8 J( j9 C(progn
(if (= no 1)
(progn
+ \/ M6 D5 f2 \(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1"")
3 a% y$ G) R+ |/ B+ p( W(command "_erase" SSL "")
))
(if (= no 2)
. x5 j" Q1 O/ e(progn
; ?+ g9 T: h9 F* g2 L+ Y3 T2 S0 c(setq l1 (length DIMENSION))
(setq p1 (cdr (nth (- l1 1) DIMENSION)))
# `/ V& A9 _) @5 I# k(setq p2 (cdr (nth (- l1 2) DIMENSION)))
(command "-bhatch" "P"  name Scale angle p1 p2 "")
(command "_erase" SSL "")
))
/ V2 ^& r6 V- o1 a(if (= no 3)
* \- G5 P) X8 E% n0 k(progn
/ r& {& ?% r* H(setq l1 (length DIMENSION))
! [" K  ]2 o& \( ?6 g. L- Z(setq p1 (cdr (nth (- l1 1) DIMENSION)))
(setq p2 (cdr (nth (- l1 2) DIMENSION)))
: Z6 ^4 b& r* e5 A: j2 M/ ~(setq p3 (cdr (nth (- l1 3) DIMENSION)))
+ X  A8 Y4 L: l(command "-bhatch" "P"  name Scale angle p1 p2 p3 "")
: q3 e; [5 @1 c- S1 |5 T(command "_erase" SSL "")
, |* U$ h* J( m  j))
2 H  w5 H. Q1 k- s0 R))
' ^+ D3 U" a# e5 A1 m2 [0 _(if (> no 3)(prompt "请选择简单图形！"))
* t) o% f1 q* g- s- p)

ZWX168

习惯上CAD画图要分若干个图层，例如："1文字"、"2标注"、"3剖面"等，下面的程序可以把不同分类的实体分别放到各自的图层中，“各就各位！”
(defun c:movelayer ()
5 i1 e! ^9 z* F3 h, g! {(setq layname "1文字")
(setq ssl (ssget "X" (list (cons 0 "MTEXT"))))
5 o1 p9 u" H8 C' Z! A* D(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq ssl (ssget "X" (list (cons 0 "TEXT"))))
3 q' g0 ~- y: ^3 z5 _/ t( F+ ]- d(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
9 z: D* [2 n0 {7 [; l(setq layname "2标注")
  d7 t) u3 A3 D( N% ~* v& \(setq ssl (ssget "X" (list (cons 0 "LEADER"))))
(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
, I# `* b2 P# L(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
* J6 ^! ?! i& ]0 Z5 l(setq layname "3剖面")
/ z9 z8 ^1 K* n( }$ m(setq ssl (ssget "X" (list (cons 0 "HATCH"))))
- ]5 Z6 W: _+ Z/ P$ V5 `, q(if (/= ssl nil) (command "ChPROP" ssl "" "layer" layname  ""))
)

ZWX168

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


6 c  a* L, I2 B
(defun C:ai_propchk()
$ {( u( f% Q% h% k(setq SSL (SSGET))
( V/ _* z  w8 X4 M3 R9 A% i(IF (= (sslength ssL) 1)
! Y1 M- N, F* k: k( F' Z(progn
(setq  DIMENSION (entget (ssname ssL 0)))
(setq TEXT (cdr (assoc '0 DIMENSION)))
(setq set 0)
(if (= TEXT  "TEXT") (progn (COMMAND "_ddedit" SSL "") (setq set 1)))
3 \% j& b. a$ x% e0 t( S! \(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)))
* J: o2 j2 @/ |& `; |+ @9 u. r(if (= TEXT  "INSERT") (progn (COMMAND "_ddatte" SSL) (setq set 1)))
(if (= set 0) (ddmodify (ssname ssL 0)))
% @- D4 O3 i1 Q)
)
* v1 x& I  A" P# r; g/ j, d. `(IF (> (sslength ssL) 1) (ddchprop ssl))
$ I( `* n$ Z% B; I# c/ x)

ZWX168

图纸中标注的尺寸，有的是标注值与实际值不等，这样的尺寸有时会带来麻烦，下面的程序可以把
+ |# x) w" I4 O3 Y/ K标注值与实际值不等的尺寸指出来，用“150号颜色”显示它。
(defun C:CHDIM()
(setq ssl (ssget "X" (list (cons 0 "DIMENSION"))))
(setq N (- (sslength ssl) 1))
$ b& F  i/ U! M1 a8 T: g6 V(setq test 0)
(while (<= test  N )
(setq DIMENSION (ENTGET (ssname ssl test)))
(setq Dimval (cdr (assoc '1 DIMENSION)))
(if (/= Dimval "")
. z% o2 \9 q# B- G(progn
(setq len (strlen Dimval))
(setq test2 1)
# x; n6 f6 l! e2 g( |( \4 Z(setq key 0)
& r( O( q9 ^2 v. X) k(while (<= test2  (- len 1))
, l9 B, X7 k# W8 a* [2 M5 U5 |: R' V(if (= (substr Dimval test2 2) "<>")(setq key 1))
" |' a' l: e8 a3 z  i(setq test2 (+ 1 test2))
)
(if (= key 1)
% ~2 D% Q& N4 u, I/ K(progn
" j# P, b: k3 o7 Y: Q(setq SS NIL)
(setq ss (ssadd))
(setq DIMENSION (ssname ssl test))
(ssadd DIMENSION SS)
/ b, y+ c) Q* A8 {(command "change" ss "" "p" "c" "150" "")
8 c3 V5 T0 m$ G3 ]4 X)
)
% s4 K! X  U( v0 U, J9 I: e: j)
)
(setq test (+ 1 test))
)
/ T5 J9 o1 E4 r. ^, Y! h)