乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 166|回复： 5

[编程交流] VLA SSGET

[复制链接]
jlogan02

78

主题

279

帖子

24

银币

中流砥柱

Rank: 25

铜币
570
发表于 2022-7-7 11:49:02 | 显示全部楼层 |阅读模式
I'm handling something wrong here. I'm trying to avoid user input by selecting the lower left hand corner of the border at 0,0 with a crossing window.
It acts like it runs but I get no printed result and the dimscale isn't updated. I'm clearly doing something wrong with my 
  1. (while (ssget
statement. Am I'm even approaching it right? Do I need to use
I've tried other variations and did get a selection set established but with it I got "bad point argument" errors.
  1. (defun c:TB_Dim (/ dim x len scale)

  2.   (setq dim (getvar 'dimscale))

  3.     (while (setq y (ssget "c" '(1 1) '(-1 -1))))

  4.      (if (setq x (vlax-ename->vla-object y)) ;;(car (entsel "\nSelect Polyline: "))))

  5.       (progn

  6.         (vla-getboundingbox x 'minpt 'maxpt)

  7.         (setq LL (vlax-safearray->list minpt)

  8.             UR (vlax-safearray->list maxpt)

  9.             L&W (mapcar '- UR LL)

  10.         )

  11.       (prompt (strcat "\nSegment length: " (rtos (car L&W) 2 4)))

  12.       (setq scale (/ (car L&W) 34))

  13.       (if (equal dim scale 0.0001)

  14.         (prompt (strcat "\nDimscale is Correct: " (rtos dim 2 4)))

  15.         (progn

  16.           (prompt (strcat "\nDimscale Changing from [" (rtos dim 2 4) "] to " (rtos scale 2 4)))

  17.           (setvar 'dimscale scale)

  18.         )

  19.       )

  20.     )

  21.     (prompt "\nNothing Selected try again")

  22.     )

  23.    )

  24.   (princ)

  25. )

Do I need an approach like this?  
  1. ;; Active Document:

  2. > (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

  3. >

  4. > (if (ssget "x" )

  5. >

  6. > (progn

  7. >

  8. > (setq ss (vla-get-ActiveSelectionSet doc))

  9. >

  10. > ;; Now ss contains the same objects found

  11. > ;; by the call to (ssget)

  12. >

  13. > ;; after you're done, you can release it:

  14. >

  15. > (vlax-release-object ss)

  16. > )

  17. > )

  18. >
回复

使用道具 举报

jlogan02

78

主题

279

帖子

24

银币

中流砥柱

Rank: 25

铜币
570
发表于 2022-7-7 13:49:40 | 显示全部楼层
Perhaps consider the following code:
  1. (defun c:tb_dim ( / box dim idx mni mxa obj scl sel )

  2.     (if (setq sel (ssget "_C" '(1 1) '(-1 -1)))

  3.         (progn

  4.             (setq dim (getvar 'dimscale)) 

  5.             (repeat (setq idx (sslength sel))

  6.                 (setq idx (1- idx)

  7.                       obj (vlax-ename->vla-object (ssname sel idx))

  8.                 )

  9.                 (vla-getboundingbox obj 'mni 'mxa)

  10.                 (setq box (mapcar '- (vlax-safearray->list mxa) (vlax-safearray->list mni))

  11.                       scl (/ (car box) 34.0)

  12.                 )

  13.                 (prompt (strcat "\nSegment Length: " (rtos (car box) 2 4)))

  14.                 (if (equal scl dim 1e-4)

  15.                     (prompt (strcat "\nDimscale is correct: " (rtos dim 2 4)))

  16.                     (progn

  17.                         (prompt (strcat "\nDimscale changing from [" (rtos dim 2 4) "] to " (rtos scl 2 4)))

  18.                         (setvar 'dimscale scl)

  19.                     )

  20.                 )

  21.             )

  22.         )

  23.         (prompt "\nNothing selected, try again.")

  24.     )

  25.     (princ)

  26. )

  27. (vl-load-com) (princ)

A few points to note:
Objects must be visible within the drawing area in order to be selected by the ssget function when a graphical selection method is used
This uses a repeat loop to iterate over the set - you may wish to consider only operating on the first object in the set, given the operations performed by the function
回复

使用道具 举报

ronjonp

58

主题

3353

帖子

33

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1761
发表于 2022-7-7 16:45:49 | 显示全部楼层
If you're only interested in one object, you can omit the index variable altogether - hence the code may become:
  1. (defun c:tb_dim ( / box dim mni mxa obj scl sel )

  2.     (if (setq sel (ssget "_C" '(1 1) '(-1 -1)))

  3.         (progn

  4.             (setq dim (getvar 'dimscale)

  5.                   obj (vlax-ename->vla-object (ssname sel 0))

  6.             )

  7.             (vla-getboundingbox obj 'mni 'mxa)

  8.             (setq box (mapcar '- (vlax-safearray->list mxa) (vlax-safearray->list mni))

  9.                   scl (/ (car box) 34.0)

  10.             )

  11.             (prompt (strcat "\nSegment Length: " (rtos (car box) 2 4)))

  12.             (if (equal scl dim 1e-4)

  13.                 (prompt (strcat "\nDimscale is correct: " (rtos dim 2 4)))

  14.                 (progn

  15.                     (prompt (strcat "\nDimscale changing from [" (rtos dim 2 4) "] to " (rtos scl 2 4)))

  16.                     (setvar 'dimscale scl)

  17.                 )

  18.             )

  19.         )

  20.         (prompt "\nNothing selected, try again.")

  21.     )

  22.     (princ)

  23. )

  24. (vl-load-com) (princ)
回复

使用道具 举报

jlogan02

78

主题

279

帖子

24

银币

中流砥柱

Rank: 25

铜币
570
发表于 2022-7-7 16:49:58 | 显示全部楼层
I swear to got I tried that!!! Musta not been squinting just right.
Thanks Lee.
Tried to combine this piece of code with another piece of code so they run from the same Defun.
It all works but I'm getting this as a return result.
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Segment Length: 272.0000
Dimscale is correct: 8.0000
Error: Function cancelledSpecify height of text or [Annotative] : *Cancel*
Unless I escape, it could run for days. But you get the idea.
  1. ;;; Sets dimscale based on length of Bottom or Top white border line.

  2. ;;; TB_DIM at command line

  3. ;;; ---------------------------------------------------------------------------------

  4. ;;;     Created 07/05/22 by Jerry Logan

  5. ;;;     Assist from MHupp/Lee Mac in The Swamp

  6. ;;;  Routine selects bottom white border line, checks it's length and sets   

  7. ;;;  Dimscale equal to that length by dividing bottom line by 34.

  8. ;;;  Refer to OneNote - Drawing Conversion Help folder "Conversion Help" page

  9. ;;;  DIMSCALE/BORDER SIZE CHART for correct dimscales.

  10. ;;; ---------------------------------------------------------------------------------

  11.  

  12. (defun tb_dim ( / box dimsc idx mni mxa obj scl sel )

  13.     (if (setq sel (ssget "_C" '(1 1) '(-1 -1)))

  14.         (progn

  15.             (setq dimsc (getvar 'dimscale) 

  16.                   obj (vlax-ename->vla-object (ssname sel 0))

  17.                 )

  18.                 (vla-getboundingbox obj 'mni 'mxa)

  19.                 (setq box (mapcar '- (vlax-safearray->list mxa) (vlax-safearray->list mni))

  20.                       scl (/ (car box) 34.0)

  21.                 )

  22.                 (prompt (strcat "\nSegment Length: " (rtos (car box) 2 4)))

  23.                 (if (equal scl dimsc 1e-4)

  24.                     (prompt (strcat "\nDimscale is correct: " (rtos dimsc 2 4)))

  25.                     (progn

  26.                         (prompt (strcat "\nDimscale changing from [" (rtos dimsc 2 4) "] to " (rtos scl 2 4)))

  27.                         (setvar 'dimscale scl)

  28.                     )

  29.                 )

  30.         )

  31.         (prompt "\nNothing selected, try again.")

  32.     )

  33.     (princ)

  34. )

  35. (vl-load-com) (princ)

  36.  

  37. ;;; -----------------------------------------------------

  38.  

  39. (defun Sctxt ( / dimsc )        

  40. (setq dimsc (getvar "dimscale"))

  41.  

  42.         (setvar "CMDECHO" 0)

  43.         (setvar "BLIPMODE" 0)

  44.  

  45.         (command ".style" "Standard" "ipco.shx" (* 1.000 dimsc) "0.85" "0" "n" "n" "n")

  46.         (command ".style" "L080" "ipco.shx" (* 0.0781 dimsc) "0.85" "0" "n" "n" "n")

  47.         (command ".style" "L100" "ipco.shx" (* 0.0938 dimsc) "0.85" "0" "n" "n" "n")

  48.         (command ".style" "L120" "ipco.shx" (* 0.1094 dimsc) "0.85" "0" "n" "n" "n")

  49.         (command ".style" "L140" "ipco.shx" (* 0.1406 dimsc) "0.85" "0" "n" "n" "n")

  50.         (command ".style" "L175" "ipco.shx" (* 0.1563 dimsc) "0.85" "0" "n" "n" "n")

  51.         (command ".style" "L200" "ipco.shx" (* 0.1719 dimsc) "0.85" "0" "n" "n" "n")

  52.         (command ".style" "L240" "ipco.shx" (* 0.2187 dimsc) "0.85" "0" "n" "n" "n")

  53.         (command ".style" "LS080" "ipco.shx" (* 0.0781 dimsc) "0.85" "20" "n" "n" "n")

  54.         (command ".style" "LS100" "ipco.shx" (* 0.0938 dimsc) "0.85" "20" "n" "n" "n")

  55.         (command ".style" "LS120" "ipco.shx" (* 0.1094 dimsc) "0.85" "20" "n" "n" "n")

  56.         (command ".style" "LS140" "ipco.shx" (* 0.1406 dimsc) "0.85" "20" "n" "n" "n")

  57.         (command ".style" "LS175" "ipco.shx" (* 0.1563 dimsc) "0.85" "20" "n" "n" "n")

  58.         (command ".style" "LS200" "ipco.shx" (* 0.1719 dimsc) "0.85" "20" "n" "n" "n")

  59.         (command ".style" "LS240" "ipco.shx" (* 0.2187 dimsc) "0.85" "20" "n" "n" "n")

  60. (princ)

  61. )

  62.  

  63. (defun c:Txt_Dim ()

  64.   (while

  65.    (tb_dim)

  66.    (sctxt)

  67.   )

  68. )

  69.   

  70.  

  71.
回复

使用道具 举报

ronjonp

58

主题

3353

帖子

33

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1761
发表于 2022-7-7 17:36:29 | 显示全部楼层
It's because you are running the functions in a while loop. Remove (while ) and it should work.
  1. (defun c:Txt_Dim ()

  2.   (while

  3.    (tb_dim)

  4.    (sctxt)

  5.   )

  6. )
回复

使用道具 举报

jlogan02

78

主题

279

帖子

24

银币

中流砥柱

Rank: 25

铜币
570
发表于 2022-7-7 18:00:35 | 显示全部楼层
Thanks Ron.
回复

使用道具 举报

返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-4 05:38 , Processed in 0.591945 second(s), 64 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表