如何获取块内门窗属性块内的属性，下段代码运行后没有输出，必须把块炸开后才有输....
(vl-ACAD-defun (DEFUN C:GWT() (ALERT "使用前请确认包括门窗编号的块没有被隐藏，无用的块已经被PURGE干净，并保证本文件名.wdt的权限属于你本人！" ) (PRINC "\n" ) (setq NEW_TAG_LIST (LIST )) (setq TAG_LIST (LIST )) (setq PRT "") (*CREATE_NEW_LAYER_BYLST* (LIST (LIST "A-Wind-Iden-FirA" 11 ) (LIST "A-Wind-Iden-Auto" 111 ) (LIST "X-Wind-Dsan" 7 ) (LIST "A-Wind-Iden-FirB" 181 ) (LIST "A-Wind-Iden-FirC" 81 ) (LIST "A-Wind-Iden-Auto-A" 31 ) (LIST "A-Wind-Iden-Auto-B" 151 ) (LIST "A-Wind-Iden-Auto-C" 51 ) ) ) (setq ACADOBJECT (vlax-get-acad-object )) (setq ACADDOCUMENT (vla-get-ActiveDocument ACADOBJECT )) (setq MSPACE (vla-get-ModelSpace ACADDOCUMENT )) (setq R_TAG_LIST (*SGET_WTAG* )) (setq HASERROR nil) (setq HASLOWERCASE nil) (setq STAND_WD "\n--------------------------------\n以下是标准门窗代码\n--------------------------------\n") (setq WD_SNAMES (*GET_FILE_CONTENT* (FINDFILE (STRCAT (*GETLOCPATH* "R" ) "WIND_LIST.txt" ) ) )) (setq WD_SNAMES (MAPCAR '(LAMBDA (X ) (LIST (SUBSTR (CADR X ) 1 (- (VL-STRING-SEARCH "\t*" (CADR X ) ) 0 ) ) (CAR X ) (SUBSTR (CADR X ) (+ 3 (VL-STRING-SEARCH "\t*" (CADR X ) ) ) ) ) ) WD_SNAMES )) (MAPCAR '(LAMBDA (X ) (SETQ GAP "" ) (REPEAT (- 10 (STRLEN (CAR X ) ) ) (SETQ GAP (STRCAT GAP " " ) ) ) (SETQ STAND_WD (STRCAT STAND_WD (CAR X ) GAP (CADDR X ) "\n" ) ) ) WD_SNAMES ) (setq ALERT_TIPS "以下门窗编号有误，与标准不符请修改: \n（见图中红圈部分 图层 X-Wind-Dsan）\n") (setq ERRTIP nil) (MAPCAR '(LAMBDA (G ) (SETQ HASERROR NIL ) (SETQ X (CAR G ) ) (SETQ NX X ) (IF (WCMATCH NX "?*（*[)）]" ) (SETQ NX (SUBSTR NX 1 (VL-STRING-SEARCH "（" NX ) ) ) ) (IF (WCMATCH NX "?*(*[)）]" ) (SETQ NX (SUBSTR NX 1 (VL-STRING-SEARCH "(" NX ) ) ) ) (IF (/= "H" (SUBSTR NX 1 1 ) ) (PROGN (IF (/= NX (VL-STRING-RIGHT-TRIM "'abcdefghijklmnopqrstuvwxyz" NX ) ) (PROGN (PRINC (STRCAT X "有小写字母后缀!\n" ) ) (SETQ HASLOWERCASE T ) ) ) (SETQ WD_TYPE (VL-STRING-RIGHT-TRIM "-1234567890" (VL-STRING-RIGHT-TRIM "'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" NX ) ) ) (IF (= NIL (ASSOC WD_TYPE WD_SNAMES ) ) (SETQ HASERROR T ) ) (SETQ WD_NUM (STRLEN (VL-STRING-TRIM "'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ甲乙丙特" NX ) ) ) (IF (= NIL (WCMATCH NX "*-*" ) ) (IF (= NIL (OR (= 4 WD_NUM ) (= 6 WD_NUM ) ) ) (SETQ HASERROR T ) ) (IF (= NIL (WCMATCH NX "*-*" ) ) (SETQ HASERROR T ) ) ) (IF (NULL (ASSOC X NEW_TAG_LIST ) ) (SETQ NEW_TAG_LIST (APPEND NEW_TAG_LIST (LIST (LIST X 1 ) ) ) PRT (STRCAT PRT "\n" X ) ) (SETQ NEW_TAG_LIST (SUBST (LIST X (1+ (CADR (ASSOC X NEW_TAG_LIST ) ) ) ) (ASSOC X NEW_TAG_LIST ) NEW_TAG_LIST ) ) ) ) ) (IF HASERROR (PROGN (SETQ ERRTIP T ) (SETQ ALERT_TIPS (STRCAT ALERT_TIPS NX " . " ) ) (SETQ VCIRCLE (vlax-invoke-method MSPACE (QUOTE ADDCIRCLE ) (vlax-3d-point (CADR G ) ) 1000.0 ) ) (vla-put-Layer VCIRCLE "X-Wind-Dsan" ) (vla-put-Color VCIRCLE 1 ) ) ) NIL ) R_TAG_LIST ) (setq TAG_LIST (MAPCAR '(LAMBDA (G ) (CAR G ) ) R_TAG_LIST ))(if ERRTIP (PROGN (PRINC (STRCAT ALERT_TIPS STAND_WD "\n" ) ) (PRINC ALERT_TIPS ) ))(if HASLOWERCASE (PROGN (ALERT "小写字母后缀用于区分同样尺寸的门窗；大写字母用于表达门窗尺寸有零数!\n" ) )) (setq HASWDC (LIST )) (setq THISWDC "") (setq LIBPATH (*GET_LIB_PATH* )) (setq NOT_MATCH_WDC nil) (setq WDC_LST (VL-DIRECTORY-FILES LIBPATH "*.wdc" )) (setq WDC_FN nil) (setq WDC_CNT 0) (setq WDC (LIST ))(if (/= nil WDC_LST ) (PROGN (setq WDC_LST (MAPCAR '(LAMBDA (FN ) (SETQ NFN (VL-FILENAME-BASE FN ) ) (WHILE (VL-STRING-SEARCH "$" NFN ) (SETQ NFN (VL-STRING-SUBST "*" "$" NFN ) ) ) (IF (WCMATCH (VL-FILENAME-BASE (GETVAR "dwgname" ) ) NFN ) (SETQ WDC_FN FN WDC_CNT (1+ WDC_CNT ) ) ) ) WDC_LST )) )) (COND ((> WDC_CNT 1 ) (ALERT "找到两个控制文件!" ) ) ((= WDC_CNT 0 ) (PRINC "没有找到控制文件!" ) ) ((= WDC_CNT 1 ) (setq WDC (MAPCAR '(LAMBDA (F ) (IF (WCMATCH (CADR F ) "*^*" ) (LIST (SUBSTR (CADR F ) 1 (VL-STRING-SEARCH "^" (CADR F ) ) ) (ATOI (SUBSTR (CADR F ) (+ 2 (VL-STRING-SEARCH "^" (CADR F ) ) ) ) ) ) (LIST (CADR F ) 0 ) ) ) (*GET_FILE_CONTENT* (FINDFILE (STRCAT LIBPATH WDC_FN ) ) ) )) (setq NEW_TAG_LIST (MAPCAR '(LAMBDA (WT ) (SETQ TAG_RIGHT "?" CNT_RIGHT "" ) (MAPCAR (QUOTE (LAMBDA (WC ) (IF (WCMATCH (CAR WT ) (CAR WC ) ) (PROGN (SETQ TAG_RIGHT "" ) (SETQ THISWDC (CAR WC ) ) (IF (/= 0 (CADR WC ) ) (IF (/= (CADR WC ) (CADR WT ) ) (SETQ NOT_MATCH_WDC T CNT_RIGHT (STRCAT " ( " (RTOS (CADR WC ) 2 0 ) " )" ) ) ) ) ) ) ) ) WDC ) (IF (/= TAG_RIGHT "" ) (SETQ NOT_MATCH_WDC T ) (SETQ HASWDC (APPEND HASWDC (LIST THISWDC ) ) ) ) (LIST (CAR WT ) (CADR WT ) TAG_RIGHT CNT_RIGHT ) ) NEW_TAG_LIST )) ) ) (setq WDC_TIP "\n------------------------------\n本图错误门窗编号及数量统计表\n------------------------------\n? 表示不符合标准\n( ) 中的数字表示正确的数量 ") (PRINC "\n------------------------------\n本图门窗编号及数量统计表\n------------------------------\n? 表示不符合标准\n( ) 中的数字表示正确的数量 " ) (MAPCAR '(LAMBDA (X ) (SETQ GAP "" TIP "" ) (IF (= 2 (LENGTH X ) ) (SETQ X (APPEND X (LIST "" "" ) ) ) ) (REPEAT (- 15 (STRLEN (STRCAT (CADDR X ) (CAR X ) ) ) ) (SETQ GAP (STRCAT GAP " " ) ) ) (PRINC (SETQ TIP (STRCAT "\n------------------------------\n " (CADDR X ) " " (CAR X ) "" GAP "" (RTOS (CADR X ) 2 0 ) (CADDDR X ) ) ) ) (IF (OR (= "?" (CADDR X ) ) (WCMATCH (CADDDR X ) "*(*)*" ) ) (SETQ WDC_TIP (STRCAT WDC_TIP TIP ) ) ) ) NEW_TAG_LIST ) (setq WDC_TIP (STRCAT WDC_TIP "\n------------------------------\n编号已复制到剪贴板" )) (PRINC "\n------------------------------\nF2查看标准门窗代码\n编号已复制到剪贴板" ) (PRINC "\n下列控制门窗编号未出现\n" ) (MAPCAR '(LAMBDA (WC ) (IF (= NIL (MEMBER (CAR WC ) HASWDC ) ) (PROGN (PRINC (CAR WC ) ) (PRINC " " ) ) ) ) WDC ) (setq F (OPEN (STRCAT (VL-STRING-RIGHT-TRIM "07其它\\J 交换数据\\" (*GET_LIB_PATH* ) ) "\\05计算书\\02 门窗\\" (VL-FILENAME-BASE (GETVAR "dwgname" ) ) ".wdt" ) "w" )) (MAPCAR '(LAMBDA (X ) (WRITE-LINE (STRCAT (CAR X ) " * " (RTOS (CADR X ) 2 0 ) ) F ) ) NEW_TAG_LIST ) (CLOSE F ) (*COPY_CLIPBOARD* PRT ) (TEXTSCR ) (COND ((AND ERRTIP NOT_MATCH_WDC ) (ALERT (STRCAT ALERT_TIPS "\n" WDC_TIP "\nF2查看标准门窗代码，如有需要可与本公司信息推广员联系增加标准代码" ) ) ) ((COND ((AND (= (AND ERRTIP (= nil NOT_MATCH_WDC ) ) ERRTIP ) NOT_MATCH_WDC ) (ALERT (VL-STRING-LEFT-TRIM " \n-" WDC_TIP ) ) ) ) (ALERT (STRCAT ALERT_TIPS "\n\nF2查看标准门窗代码，如有需要可与本公司信息推广员联系增加标准代码" ) ) ) )(if (= 0 (FILE_OK "gwt" ) ) (PROGN (EXIT ) )) (PRINC )) )'C:GWT
(DEFUN *SGET_WTAG*() (setq T_TIME (GETVAR "date" )) (setq DPTS nil) (setq STBLK_LST nil) (setq HASBN_LST nil) (setq ELST nil) (setq B_ELST nil) (setq S (SSGET "X" '((0 . "INSERT") ) )) (setq MSPACE (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object ) ) )) (setq BS (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object ) ) )) (setq B_ELST nil) (setq $P nil) (setq #P nil) (setq P nil) (setq R nil) (setq M nil) (setq K nil) (setq S_IDX -1) (setq W nil)(if (/= nil S ) (PROGN (REPEAT (SSLENGTH S ) (setq N (vla-get-EffectiveName (setqE (vlax-ename->vla-object (SSNAME S (setqS_IDX (1+ S_IDX )) ) )) ))(if (WCMATCH (STRCASE N ) "*JB*W*TAG*" ) (PROGN (setq DPTS (APPEND DPTS (LIST (LIST (*GVATT* E ) (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint E ) ) ) ) ) )) )(PROGN (if (= nil (ASSOC N W ) ) (PROGN (setq W (APPEND W (LIST (LIST N ) ) )) )) (setq P (APPEND P (LIST (LIST E MSPACE ) ) ))(if (NOT (ASSOC N R ) ) (PROGN (setq R (APPEND R (LIST (LIST N E ) ) )) )(PROGN (setq R (SUBST (APPEND (ASSOC N R ) (LIST E ) ) (ASSOC N R ) R )) )) )) ) (setq K W) (setq H nil) (setq #K K) (while (and (/= nil #K )) (MAPCAR '(LAMBDA (BN ) (SETQ ELST NIL ) (IF (= NIL (ASSOC (CAR BN ) H ) ) (PROGN (SETQ H (APPEND H (LIST BN ) ) ) (VLAX-FOR E (SETQ V (vla-Item BS (CAR BN ) ) ) (IF (WCMATCH (VL-PRINC-TO-STRING E ) "*BlockReference2*,*ExternalReference2*" ) (IF (/= T (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY (QUOTE vla-get-EffectiveName ) (LIST E ) ) ) ) (PROGN (IF (WCMATCH (STRCASE (SETQ N (vla-get-EffectiveName E ) ) ) "*JB*W*TAG*" ) (SETQ ELST (APPEND ELST (LIST (LIST N (*GVATT* E ) E (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint E ) ) ) ) ) ) ) ) (IF (= NIL (ASSOC N H ) ) (SETQ K (APPEND K (LIST (LIST N ) ) ) ) ) (SETQ P (APPEND P (LIST (LIST E V ) ) ) ) (IF (NULL (ASSOC N R ) ) (SETQ R (APPEND R (LIST (LIST N E ) ) ) ) (SETQ R (SUBST (APPEND (ASSOC N R ) (LIST E ) ) (ASSOC N R ) R ) ) ) ) ) ) ) (IF (/= NIL ELST ) (SETQ B_ELST (APPEND B_ELST (LIST (LIST (CAR BN ) ELST ) ) ) ) ) ) ) ) #K ) (setq #K K) (setq K nil) ) )) (MAPCAR '(LAMBDA (BD ) (SETQ #P (CDR (ASSOC (CAR BD ) R ) ) M NIL ) (WHILE (/= NIL #P ) (MAPCAR (QUOTE (LAMBDA (C ) (IF (= (TYPE C ) (QUOTE LIST ) ) (SETQ G (CAR C ) ) (SETQ G C C (LIST C ) ) ) (IF (WCMATCH (VL-PRINC-TO-STRING (LAST C ) ) "?<VLA-OBJECT IAcadBlock *,?????????????IAcadModelSpace*" ) (SETQ C (LIST (CAR C ) ) ) ) (IF (WCMATCH (VL-PRINC-TO-STRING (SETQ B (CADR (ASSOC G P ) ) ) ) "?????????????IAcadModelSpace*" ) (SETQ M (APPEND M (LIST C ) ) ) (MAPCAR (QUOTE (LAMBDA (F ) (SETQ $P (APPEND $P (LIST (APPEND (LIST F ) C ) ) ) ) ) ) (CDR (ASSOC (vla-get-Name B ) R ) ) ) ) ) ) #P ) (SETQ #P $P $P NIL ) ) (MAPCAR (QUOTE (LAMBDA (MT ) (SETQ TM (vlax-safearray->list (vlax-variant-value (LAST (*GET_A_MATRIX_LST* (MAPCAR (QUOTE (LAMBDA (I ) (vlax-vla-object->ename I ) ) ) (REVERSE MT ) ) ) ) ) ) ) (MAPCAR (QUOTE (LAMBDA (D ) (SETQ DPTS (APPEND DPTS (LIST (LIST (CADR D ) (MAT:MXP TM (LAST D ) ) ) ) ) ) NIL ) ) (CADR BD ) ) NIL ) ) M ) NIL ) B_ELST ) (PRINC (STRCAT "\n总计时间：" (RTOS (* 86400 (- (GETVAR "date" ) T_TIME ) ) 2 3 ) ) ) (setq DPTS (MAPCAR '(LAMBDA (G ) (LIST (VL-STRING-TRIM " " (CAR G ) ) (CADR G ) ) ) DPTS )) DPTS)
猜猜谁会这样写：
(vl-ACAD-defun
(PROGN
'C:GWT
不要太明显，建议自己好好学习。 获取属性块儿的属性 本论坛有类似代码 破解的代码，就不要发过来让别人改了。 这种尿性的都不值得帮。让他自己折腾去，反正他觉得时间和劳动成果不值钱。 原程序用的不香吗？如果原程序有问题那就找作者解决。
CREATE_NEW_LAYER_BYLST：少了个函数;P 嘿嘿，懂的都懂，就不要问了
页:
[1]