设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 求助：以下的代码是一个标注断开的lsp,，能不能像理正建 ...
返回列表 发新帖
查看: 1658|回复: 7

求助：以下的代码是一个标注断开的lsp,，能不能像理正建筑那种把他改成连续断开的形式

[复制链接]
0_zh_0
发表于 2011-7-28 20:57:26 | 显示全部楼层 |阅读模式
这个命令不能连续断开  只能一下一下的点 就是叫他连续点标注 不用每次都用回车  麻烦各位大侠了
  1. (PRINC "\n尺寸断开命令: DIMB . 尺寸界限对齐:DB . 尺寸标注点对齐: DV . 尺寸宽度取齐: DIMW")
  2. (DEFUN C:DB (/ ANG DIMALANG DIMENT DIMPT10 DIMPT1013 DIMPT11
  3. DIMPT12 DIMPT13 DIMPT14 DIMPT15 DIMSEL DIST ENAME
  4. PT0 PT1 PTREF SELPT DIMANG1 DIMANG2 DIST2PT
  5. ID NDIST PT10 PT14 PTFROM
  6. )
  7. (DEFUN LHB-GET-DXF (CODE ENAME) (CDR (ASSOC CODE (ENTGET ENAME))))
  8. (DEFUN *$MYERROR$* (MSG)
  9. (SETVAR "BLIPMODE" OLDBLIP)
  10. (SETVAR "OSMODE" OLDOS)
  11. (SETVAR "CMDECHO" OLDCMD)
  12. (COMMAND ".UNDO" "")
  13. (SETQ *ERROR* &OLDERR&)
  14. (PRINC)
  15. )
  16. (SETQ &OLDERR& *ERROR*)
  17. (SETQ *ERROR* *$MYERROR$*)
  18. (SETQ OLDCMD (GETVAR "CMDECHO"))
  19. (SETQ OLDOS (GETVAR "OSMODE"))
  20. (SETQ OLDBLIP (GETVAR "BLIPMODE"))
  21. (SETVAR "CMDECHO" 0)
  22. (SETVAR "BLIPMODE" 1)
  23. (SETVAR "OSMODE" (+ 1 2 4 8 16 32 128 512 2048 4096))
  24. (SETQ
  25. DIMSEL (XENTSEL "\n拾取要拆分的尺寸(定位基点靠近点取位置)<退出>:"
  26. "U"
  27. '((0 . "DIMENSION"))
  28. )
  29. )
  30. (IF DIMSEL
  31. (PROGN
  32. (SETQ ENAME (CAR DIMSEL))
  33. (SETQ DIMENT (ENTGET ENAME))
  34. (REDRAW ENAME 3)
  35. (SETQ SELPT (CADR DIMSEL))
  36. (SETQ DIMPT10 (LHB-GET-DXF 10 ENAME))
  37. (SETQ DIMPT13 (LHB-GET-DXF 13 ENAME))
  38. (SETQ DIMPT14 (LHB-GET-DXF 14 ENAME))
  39. (IF (MEMBER '(100 . "AcDbRotatedDimension") (ENTGET ENAME))
  40. (PROGN ;线性标注
  41. (SETQ DIMALANG (LHB-GET-DXF 50 ENAME))
  42. (COND
  43. ((OR (= DIMALANG 0.0) (= DIMALANG PI))
  44. (SETQ DIMPT1013 (LIST (CAR DIMPT13)
  45. (CADR DIMPT10)
  46. (CADDR DIMPT10)
  47. )
  48. )
  49. )
  50. ((OR (= DIMALANG (* PI 0.5)) (= DIMALANG (* PI 1.5)))
  51. (SETQ DIMPT1013 (LIST (CAR DIMPT10)
  52. (CADR DIMPT13)
  53. (CADDR DIMPT13)
  54. )
  55. )
  56. )
  57. (T
  58. (SETQ PT1 (POLAR DIMPT10 DIMALANG 10))
  59. (SETQ PT0 (POLAR DIMPT13 (+ DIMALANG (* PI 0.5)) 10))
  60. (SETQ DIMPT1013 (INTERS DIMPT13 PT0 DIMPT10 PT1 NIL))
  61. )
  62. ) ; END COND
  63. (IF (< (DISTANCE DIMPT1013 SELPT) (DISTANCE DIMPT10 SELPT))
  64. (SETQ PTFROM DIMPT1013)
  65. (SETQ PTFROM DIMPT10)
  66. )
  67. (INITGET 129)
  68. (SETQ PTREF
  69. (GETPOINT
  70. PTFROM
  71. "\n点取尺寸断开点 /输断开长度 /数值N - N等分<退出>:"
  72. )
  73. )
  74. (SETQ ID T)
  75. (WHILE ID
  76. (IF (OR (LISTP PTREF)
  77. (AND (ZEROP (REM (ATOF PTREF) 1))
  78. (NOT (ZEROP (ATOF PTREF)))
  79. )
  80. )
  81. (SETQ ID NIL)
  82. (PROGN
  83. (PRINC "\n***** 输入值无效,请重新输入! *****")
  84. (INITGET 129)
  85. (SETQ PTREF
  86. (GETPOINT
  87. PTFROM
  88. "\n点取尺寸断开点 /输断开长度 /数值N - N等分<退出>:"
  89. )
  90. )
  91. )
  92. )
  93. ) ; END OF WHILE ID
  94. (IF (LISTP PTREF)
  95. (PROGN
  96. (SETQ DIMPT15 (POLAR PTREF (+ DIMALANG (* PI 0.5)) 10))
  97. (SETQ DIMPT11 (INTERS DIMPT15
  98. PTREF
  99. DIMPT10
  100. (POLAR DIMPT10 DIMALANG 10)
  101. NIL
  102. )
  103. )
  104. (SETQ ANG (ANGLE DIMPT10 DIMPT14))
  105. (IF
  106. (< (DISTANCE DIMPT1013 DIMPT11)
  107. (DISTANCE DIMPT10 DIMPT11)
  108. )
  109. (SETQ DIST (DISTANCE DIMPT13 DIMPT1013))
  110. (SETQ DIST (DISTANCE DIMPT14 DIMPT10))
  111. )
  112. (SETQ DIMPT12 (POLAR DIMPT11 ANG DIST))
  113. (IF (AND (< (DISTANCE DIMPT11 DIMPT10)
  114. (DISTANCE DIMPT10 DIMPT1013)
  115. )
  116. (< (DISTANCE DIMPT11 DIMPT1013)
  117. (DISTANCE DIMPT10 DIMPT1013)
  118. )
  119. ) ;断开点在尺寸线上
  120. (PROGN
  121. (NEWDIM DIMPT11
  122. DIMPT12
  123. (CDR (ASSOC 13 DIMENT))
  124. DIMENT
  125. )
  126. (SETQ DIMENT (SUBST (CONS 13 DIMPT12)
  127. (ASSOC 13 DIMENT)
  128. DIMENT
  129. )
  130. )
  131. (ENTMOD DIMENT)
  132. )
  133. (PROGN
  134. (IF (< (DISTANCE DIMPT1013 DIMPT11)
  135. (DISTANCE DIMPT10 DIMPT11)
  136. )
  137. (NEWDIM DIMPT11
  138. DIMPT12
  139. (CDR (ASSOC 13 DIMENT))
  140. DIMENT
  141. )
  142. (NEWDIM DIMPT11
  143. DIMPT12
  144. (CDR (ASSOC 14 DIMENT))
  145. DIMENT
  146. )
  147. )
  148. (REDRAW ENAME 4)
  149. )
  150. )
  151. ) ;END OF PROGN
  152. (PROGN
  153. (SETQ DIST2PT (DISTANCE DIMPT10 DIMPT1013))
  154. (SETQ NDIST (/ DIST2PT (ATOI PTREF)))
  155. (SETQ DIMANG1 (ANGLE DIMPT1013 DIMPT10))
  156. (SETQ DIMANG2 (ANGLE DIMPT10 DIMPT14))
  157. (SETQ DIST (DISTANCE DIMPT10 DIMPT14))
  158. (REPEAT (- (ATOI PTREF) 1)
  159. (SETQ PT10 (POLAR DIMPT1013 DIMANG1 NDIST))
  160. (SETQ PT14 (POLAR PT10 DIMANG2 DIST))
  161. (NEWDIM PT10 PT14 DIMPT13 DIMENT)
  162. (SETQ DIMPT1013 PT10)
  163. (SETQ DIMPT13 PT14)
  164. )
  165. (SETQ DIMENT (SUBST (CONS 13 PT14)
  166. (ASSOC 13 DIMENT)
  167. DIMENT
  168. )
  169. )
  170. (ENTMOD DIMENT)
  171. )
  172. )
  173. )
  174. (PROGN ;对齐标注
  175. (SETQ DIMALANG (ANGLE DIMPT13 DIMPT14))
  176. (SETQ PT1 (POLAR DIMPT10 DIMALANG 10))
  177. (SETQ PT0 (POLAR DIMPT13 (+ DIMALANG (* PI 0.5)) 10))
  178. (SETQ DIMPT1013 (INTERS DIMPT13 PT0 DIMPT10 PT1 NIL))
  179. (IF (< (DISTANCE DIMPT1013 SELPT) (DISTANCE DIMPT10 SELPT))
  180. (SETQ PTFROM DIMPT1013)
  181. (SETQ PTFROM DIMPT10)
  182. )
  183. (INITGET 129)
  184. (SETQ PTREF
  185. (GETPOINT
  186. PTFROM
  187. "\n点取尺寸断开点 /输断开长度 /数值N - N等分<退出>:"
  188. )
  189. )
  190. (SETQ ID T)
  191. (WHILE ID
  192. (IF (OR (LISTP PTREF)
  193. (AND (ZEROP (REM (ATOF PTREF) 1))
  194. (NOT (ZEROP (ATOF PTREF)))
  195. )
  196. )
  197. (SETQ ID NIL)
  198. (PROGN
  199. (PRINC "\n***** 输入值无效,请重新输入! *****")
  200. (INITGET 129)
  201. (SETQ PTREF
  202. (GETPOINT
  203. PTFROM
  204. "\n点取尺寸断开点 /输断开长度 /数值N - N等分<退出>:"
  205. )
  206. )
  207. )
  208. )
  209. ) ; END OF WHILE ID
  210. (IF (LISTP PTREF)
  211. (PROGN
  212. (SETQ DIMPT15 (POLAR PTREF (+ DIMALANG (* PI 0.5)) 10))
  213. (SETQ DIMPT11 (INTERS DIMPT15
  214. PTREF
  215. DIMPT10
  216. (POLAR DIMPT10 DIMALANG 10)
  217. NIL
  218. )
  219. )
  220. (SETQ ANG (ANGLE DIMPT10 DIMPT14))
  221. (IF
  222. (< (DISTANCE DIMPT1013 DIMPT11)
  223. (DISTANCE DIMPT10 DIMPT11)
  224. )
  225. (SETQ DIST (DISTANCE DIMPT13 DIMPT1013))
  226. (SETQ DIST (DISTANCE DIMPT14 DIMPT10))
  227. )
  228. (SETQ DIMPT12 (POLAR DIMPT11 ANG DIST))
  229. (IF (AND (< (DISTANCE DIMPT11 DIMPT10)
  230. (DISTANCE DIMPT10 DIMPT1013)
  231. )
  232. (< (DISTANCE DIMPT11 DIMPT1013)
  233. (DISTANCE DIMPT10 DIMPT1013)
  234. )
  235. ) ;断开点在尺寸线上
  236. (PROGN
  237. (NEWDIMALI DIMPT11
  238. DIMPT12
  239. (CDR (ASSOC 13 DIMENT))
  240. DIMENT
  241. )
  242. (SETQ DIMENT (SUBST (CONS 13 DIMPT12)
  243. (ASSOC 13 DIMENT)
  244. DIMENT
  245. )
  246. )
  247. (ENTMOD DIMENT)
  248. )
  249. (PROGN
  250. (IF (< (DISTANCE DIMPT1013 DIMPT11)
  251. (DISTANCE DIMPT10 DIMPT11)
  252. )
  253. (NEWDIMALI DIMPT11
  254. DIMPT12
  255. (CDR (ASSOC 13 DIMENT))
  256. DIMENT
  257. )
  258. (NEWDIMALI DIMPT11
  259. DIMPT12
  260. (CDR (ASSOC 14 DIMENT))
  261. DIMENT
  262. )
  263. )
  264. (REDRAW ENAME 4)
  265. )
  266. )
  267. ) ;END OF PROGN
  268. (PROGN
  269. (SETQ DIST2PT (DISTANCE DIMPT10 DIMPT1013))
  270. (SETQ NDIST (/ DIST2PT (ATOI PTREF)))
  271. (SETQ DIMANG1 (ANGLE DIMPT1013 DIMPT10))
  272. (SETQ DIMANG2 (ANGLE DIMPT10 DIMPT14))
  273. (SETQ DIST (DISTANCE DIMPT10 DIMPT14))
  274. (REPEAT (- (ATOI PTREF) 1)
  275. (SETQ PT10 (POLAR DIMPT1013 DIMANG1 NDIST))
  276. (SETQ PT14 (POLAR PT10 DIMANG2 DIST))
  277. (NEWDIMALI PT10 PT14 DIMPT13 DIMENT)
  278. (SETQ DIMPT1013 PT10)
  279. (SETQ DIMPT13 PT14)
  280. )
  281. (SETQ DIMENT (SUBST (CONS 13 PT14)
  282. (ASSOC 13 DIMENT)
  283. DIMENT
  284. )
  285. )
  286. (ENTMOD DIMENT)
  287. )
  288. )
  289. )
  290. )
  291. )
  292. )
  293. (SETVAR "BLIPMODE" OLDBLIP)
  294. (SETVAR "OSMODE" OLDOS)
  295. (COMMAND ".UNDO" "E")
  296. (SETVAR "CMDECHO" OLDCMD)
  297. (SETQ *ERROR* &OLDERR&)
  298. (PRINC)
  299. )
  300. (DEFUN NEWDIM (DIMPT11 DIMPT14 DIMPT13 DIMENT)
  301. (SETQ NEWDIM1
  302. (LIST
  303. '(0 . "DIMENSION")
  304. '(100 . "AcDbEntity")
  305. (CONS 67 (CDR (ASSOC 67 DIMENT)))
  306. '(100 . "AcDbDimension")
  307. (CONS 8 (CDR (ASSOC 8 DIMENT)))
  308. (CONS 10 DIMPT11)
  309. (CONS 12 (CDR (ASSOC 12 DIMENT)))
  310. (CONS 70 (CDR (ASSOC 70 DIMENT)))
  311. '(1 . "")
  312. (CONS 71 (CDR (ASSOC 71 DIMENT)))
  313. (CONS 72 (CDR (ASSOC 72 DIMENT)))
  314. (CONS 41 (CDR (ASSOC 41 DIMENT)))
  315. (CONS 52 (CDR (ASSOC 52 DIMENT)))
  316. (CONS 53 (CDR (ASSOC 53 DIMENT)))
  317. (CONS 54 (CDR (ASSOC 54 DIMENT)))
  318. (CONS 51 (CDR (ASSOC 51 DIMENT)))
  319. (CONS 3 (CDR (ASSOC 3 DIMENT)))
  320. '(100 . "AcDbAlignedDimension")
  321. (CONS 13 DIMPT13)
  322. (CONS 14 DIMPT14)
  323. (CONS 15 (CDR (ASSOC 15 DIMENT)))
  324. (CONS 16 (CDR (ASSOC 16 DIMENT)))
  325. (CONS 40 (CDR (ASSOC 40 DIMENT)))
  326. (CONS 50 (CDR (ASSOC 50 DIMENT)))
  327. '(100 . "AcDbRotatedDimension")
  328. )
  329. )
  330. (ENTMAKE NEWDIM1)
  331. )
  332. (DEFUN NEWDIMALI (DIMPT11 DIMPT14 DIMPT13 DIMENT)
  333. (SETQ NEWDIM1
  334. (LIST
  335. '(0 . "DIMENSION")
  336. '(100 . "AcDbEntity")
  337. (CONS 67 (CDR (ASSOC 67 DIMENT)))
  338. '(100 . "AcDbDimension")
  339. (CONS 8 (CDR (ASSOC 8 DIMENT)))
  340. (CONS 10 DIMPT11)
  341. (CONS 12 (CDR (ASSOC 12 DIMENT)))
  342. (CONS 70 (CDR (ASSOC 70 DIMENT)))
  343. '(1 . "")
  344. (CONS 71 (CDR (ASSOC 71 DIMENT)))
  345. (CONS 72 (CDR (ASSOC 72 DIMENT)))
  346. (CONS 41 (CDR (ASSOC 41 DIMENT)))
  347. (CONS 52 (CDR (ASSOC 52 DIMENT)))
  348. (CONS 53 (CDR (ASSOC 53 DIMENT)))
  349. (CONS 54 (CDR (ASSOC 54 DIMENT)))
  350. (CONS 51 (CDR (ASSOC 51 DIMENT)))
  351. (CONS 3 (CDR (ASSOC 3 DIMENT)))
  352. '(100 . "AcDbAlignedDimension")
  353. (CONS 13 DIMPT13)
  354. (CONS 14 DIMPT14)
  355. (CONS 15 (CDR (ASSOC 15 DIMENT)))
  356. (CONS 16 (CDR (ASSOC 16 DIMENT)))
  357. (CONS 40 (CDR (ASSOC 40 DIMENT)))
  358. (CONS 50 (CDR (ASSOC 50 DIMENT)))
  359. )
  360. )
  361. (ENTMAKE NEWDIM1)
  362. )
  363. (DEFUN XENTSEL (MSG KEYWORD FILTER_LIST / $S0 $S01)
  364. (INITGET KEYWORD)
  365. (SETQ $S0 (ENTSEL MSG))
  366. (COND
  367. ((AND (= $S0 NIL) (= (GETVAR "ERRNO") 52)) NIL) ;回车结束，返回NIL
  368. ((= $S0 NIL) (XENTSEL MSG KEYWORD FILTER_LIST)) ;空选重复
  369. ((= (TYPE $S0) 'STR) $S0) ;返回关键字
  370. ((= (TYPE $S0) 'LIST) ;返回实体与点表，与ENTSEL相同
  371. (IF FILTER_LIST ;存在特征关联表
  372. (IF (AND (SETQ $S01 (SSGET (CADR $S0) FILTER_LIST))
  373. (SSMEMB (CAR $S0) $S01)
  374. )
  375. $S0 ;真，返回实体与点表
  376. (XENTSEL MSG KEYWORD FILTER_LIST) ;假，循环拾取
  377. )
  378. $S0
  379. )
  380. )
  381. (T (XENTSEL MSG KEYWORD FILTER_LIST)) ;其它拾取及输入情况，循环拾取
  382. )
  383. )


回复

使用道具 举报

ljpnb
发表于 2011-7-29 06:41:17 | 显示全部楼层
此帖仅作者可见

使用道具 举报

0_zh_0
 楼主| 发表于 2011-7-30 16:19:17 | 显示全部楼层
此帖仅作者可见

使用道具 举报

userzhl
发表于 2011-10-14 13:06:56 | 显示全部楼层
此帖仅作者可见

使用道具 举报

xiaxiang
发表于 2011-10-14 14:16:15 | 显示全部楼层
此帖仅作者可见

使用道具 举报

仲文玉
发表于 2011-10-14 19:03:46 | 显示全部楼层
此帖仅作者可见

使用道具 举报

注册
发表于 2012-4-15 18:43:44 | 显示全部楼层
此帖仅作者可见

使用道具 举报

流动的清泉
发表于 2021-4-8 15:56:27 | 显示全部楼层
此帖仅作者可见

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-5-16 21:08 , Processed in 0.163690 second(s), 24 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表