;;;Purpose: edit or add TIN points by entities: (1) CIRCLE - uses center point for 3D point information ;;; (2) POLYLINE - heavy 3D polyline - uses vertex locations for 3D point information ;;; ;;; Author: Henry C. Francis ;;; 425 N. Ashe St. ;;; Southern Pines, NC 28387 ;;; ;;; http://www.paracadd.com ;;; All rights reserved. ;;; ;;; Copyright: 5/5/2014 ;;; Edited: 5/15/2014 ;;; ;;;COMMANDS DEFINED: EDITPTSBYENT & EPBE (long and short command name) ;;; ADDPTSBYENT & APBE (long and short command name) ;;; ;;;**************************************************************************** (DEFUN ptsby_error (msg /) (IF old_ptsby_osmode (SETVAR "osmode" old_ptsby_osmode) (SETVAR "osmode" 1285) ;my default ) ;_ end of IF (IF old_epbe_pickbox (SETVAR "pickbox" old_epbe_pickbox) ) (IF old_epbe_aperture (SETVAR "aperture" old_epbe_aperture) ) (PRINC "\n") (PRINC msg) (PRINC) (IF old_ptsby_error (SETQ *error* old_ptsby_error) (SETQ *error* NIL) ) ;_ end of IF (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:editptsbyent (/) (SETQ used_pt_list NIL source_ss NIL cnt NIL old_osmode NIL this_ent NIL tinpt_list NIL same-cnt 0 old_epbe_pickbox (GETVAR "pickbox") old_epbe_aperture (GETVAR "aperture") ) ;_ end of SETQ (SETQ old_ptsby_error *error*) (SETQ *error* ptsby_error) (PRINC "\nSelect object defining surface points to edit: ") (PRINC) (SETQ source_ss (SSGET '((-4 . "")) ) ;_ end of SSGET ) ;_ end of SETQ (SETQ cnt 0) (SETQ old_osmode (GETVAR "osmode")) (SETVAR "osmode" 1025) (WHILE (< cnt (SSLENGTH source_ss)) (COND ((AND (WCMATCH (CDR (ASSOC 0 (SETQ this_ent (ENTGET (SETQ this_ename (SSNAME source_ss cnt)))) ) ;_ end of ASSOC ) ;_ end of CDR "POLYLINE" ) ;_ end of WCMATCH (EQ (BOOLE 1 (CDR (ASSOC 70 this_ent)) 8) 8) ) ;_ end of AND (PROGN (WHILE (AND (ENTNEXT this_ename) (SETQ this_ent (ENTGET (ENTNEXT this_ename))) (NOT (EQ (CDR (ASSOC 0 this_ent)) "SEQEND")) ) ;_ end of AND (IF (WCMATCH (CDR (ASSOC 0 this_ent)) "VERTEX") (IF tinpt_list (SETQ tinpt_list (APPEND tinpt_list (LIST (CDR (ASSOC 10 this_ent)))) ) ;_ end of SETQ (SETQ tinpt_list (LIST (CDR (ASSOC 10 this_ent)))) ) ;_ end of IF ) ;_ end of IF (SETQ this_ename (CDR (ASSOC -1 this_ent))) ) ;_ end of WHILE ) ;_ end of PROGN ) ((WCMATCH (CDR (ASSOC 0 (SETQ this_ent (ENTGET (SETQ this_ename (SSNAME source_ss cnt)))) ) ;_ end of ASSOC ) ;_ end of CDR "CIRCLE" ) ;_ end of WCMATCH (IF tinpt_list (SETQ tinpt_list (APPEND tinpt_list (LIST (CDR (ASSOC 10 this_ent))))) (SETQ tinpt_list (LIST (CDR (ASSOC 10 this_ent)))) ) ;_ end of IF ) ((WCMATCH (CDR (ASSOC 0 (SETQ this_ent (ENTGET (SETQ this_ename (SSNAME source_ss cnt)))) ) ;_ end of ASSOC ) ;_ end of CDR "POINT" ) ;_ end of WCMATCH (IF tinpt_list (SETQ tinpt_list (APPEND tinpt_list (LIST (CDR (ASSOC 10 this_ent))))) (SETQ tinpt_list (LIST (CDR (ASSOC 10 this_ent)))) ) ;_ end of IF ) (T (SETQ tinpt_list NIL)) ) ;_ end of COND (SETQ cnt (1+ cnt)) ) ;_ end of WHILE (IF tinpt_list (PROGN (PRINC "\nSelect surface to edit: ") (PRINC) (SETQ the_selection (ENTSEL)) (IF (AND the_selection (EQ (CDR (ASSOC 0 (ENTGET (CAR the_selection)))) "AECC_TIN_SURFACE" ) ;_ end of EQ ) ;_ end of AND (PROGN (SETQ surfobj (VLAX-ENAME->VLA-OBJECT (CAR the_selection))) (SETQ surface_pts_list (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLAX-GET-PROPERTY surfobj 'Points) ) ;_ end of vlax-variant-value ) ;_ end of vlax-safearray->list ) ;_ end of SETQ (SETQ surface_name (VLAX-GET-PROPERTY surfobj 'Name)) ) ;_ end of PROGN ) ;_ end of IF (SETQ ccnt 1) (FOREACH n tinpt_list (IF (AND (SETQ this_pt (MEMBER (CAR n) surface_pts_list)) (EQUAL (CADR this_pt) (CADR n)) ) ;_ end of AND (IF (EQUAL (CADDR this_pt) (CADDR n)) (SETQ same-cnt (1+ same-cnt)) (SETQ used_pt_list (APPEND used_pt_list (LIST (LIST (CAR this_pt) (CADR this_pt) (CADDR this_pt) (CADDR n) ) ;_ end of LIST ) ;_ end of LIST ) ;_ end of APPEND ) ;_ end of SETQ ) ;_ end of IF ) ;_ end of IF (SETQ ccnt (1+ ccnt)) ) ;_ end of FOREACH (COMMAND "EDITSURFACEPOINT") (IF (> (SSLENGTH (SSGET "X" '((0 . "AECC_TIN_SURFACE")))) 1) (COMMAND "") ) (SETVAR "pickbox" 1) (SETVAR "aperture" 1) (FOREACH n used_pt_list (SETQ this_pt (REVERSE (CDDR (REVERSE n)))) (COMMAND (polar (reverse (cdr (reverse n))) 0.0 0.25) "" (CAR (REVERSE n))) ;;; (STRCAT (RTOS (CAR this_pt) 2 10) "," (RTOS (CADR this_pt) 2 10) "," (RTOS (CADDR this_pt) 2 10) " " (RTOS (LAST n) 2 4))) ;;; (COMMAND "") ;;; (COMMAND (RTOS (LAST n) 2 4)) ) ;_ end of FOREACH (COMMAND "") (SETQ plobjstr (IF (> (SSLENGTH source_ss) 1) "s" "" ) ;_ end of IF ) ;_ end of SETQ (SETQ plpntstr (IF (> (LENGTH tinpt_list) 1) "s" "" ) ;_ end of IF ) ;_ end of SETQ (SETQ plunch (IF (> same-cnt 1) "s" "" ) ;_ end of IF ) ;_ end of SETQ (IF (> same-cnt 0) (PRINC (STRCAT "\n" (ITOA same-cnt) " point" plunch (IF (EQ plunch "s") " were " " was " ) ;_ end of IF "unchanged. " ) ;_ end of STRCAT ) ;_ end of PRINC ) ;_ end of IF (IF (EQ same-cnt (LENGTH tinpt_list)) (PRINC (STRCAT "\nThe 3D information from the object" plobjstr " was the same as the existing points. " ) ;_ end of STRCAT ) ;_ end of PRINC (PRINC (STRCAT "\nAttempted edit" plobjstr " applied to " (ITOA (LENGTH used_pt_list)) " existing point elevation" plpntstr " using 3D information from " (ITOA (SSLENGTH source_ss)) " object" plobjstr ) ;_ end of STRCAT ) ;_ end of PRINC ) ;_ end of IF (PRINC) ) ;_ end of PROGN (ALERT "No Circles or 3D Polylines were selected! ") ) ;_ end of IF (SETVAR "osmode" old_osmode) (SETQ *error* old_ptsby_error) (SETVAR "pickbox" old_epbe_pickbox) (SETVAR "aperture" old_epbe_aperture) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:epbe () (c:editptsbyent)) ;;;**************************************************************************** (DEFUN c:addptsbyent (/ source_ss cnt old_osmode this_ent tinpt_list) (SETQ old_ptsby_error *error*) (SETQ *error* ptsby_error) (SETQ source_ss (SSGET '((-4 . "")) ) ;_ end of SSGET ) ;_ end of SETQ (SETQ cnt 0) (SETQ old_osmode (GETVAR "osmode")) (SETVAR "osmode" 0) (WHILE (AND source_ss (< cnt (SSLENGTH source_ss))) (COND ((AND (WCMATCH (CDR (ASSOC 0 (SETQ this_ent (ENTGET (SETQ this_ename (SSNAME source_ss cnt)))) ) ;_ end of ASSOC ) ;_ end of CDR "POLYLINE" ) ;_ end of WCMATCH T ;;(EQ (BOOLE 1 (CDR (ASSOC 70 this_ent)) 8) 8) ) ;_ end of AND (PROGN (WHILE (AND (ENTNEXT this_ename) (SETQ this_ent (ENTGET (ENTNEXT this_ename))) (NOT (EQ (CDR (ASSOC 0 this_ent)) "SEQEND")) ) ;_ end of AND (IF (WCMATCH (CDR (ASSOC 0 this_ent)) "VERTEX") (IF tinpt_list (SETQ tinpt_list (APPEND tinpt_list (LIST (CDR (ASSOC 10 this_ent)))) ) ;_ end of SETQ (SETQ tinpt_list (LIST (CDR (ASSOC 10 this_ent)))) ) ;_ end of IF ) ;_ end of IF (SETQ this_ename (CDR (ASSOC -1 this_ent))) ) ;_ end of WHILE ) ;_ end of PROGN ) ((WCMATCH (CDR (ASSOC 0 (SETQ this_ent (ENTGET (SETQ this_ename (SSNAME source_ss cnt)))) ) ;_ end of ASSOC ) ;_ end of CDR "CIRCLE,ELLIPSE,POINT" ) ;_ end of WCMATCH (IF tinpt_list (SETQ tinpt_list (APPEND tinpt_list (LIST (CDR (ASSOC 10 this_ent))))) (SETQ tinpt_list (LIST (CDR (ASSOC 10 this_ent)))) ) ;_ end of IF ) ((WCMATCH (CDR (ASSOC 0 (SETQ this_ent (ENTGET (SETQ this_ename (SSNAME source_ss cnt)))) ) ;_ end of ASSOC ) ;_ end of CDR "LINE" ) ;_ end of WCMATCH (IF tinpt_list (SETQ tinpt_list (APPEND tinpt_list (LIST (CDR (ASSOC 10 this_ent))))) (SETQ tinpt_list (LIST (CDR (ASSOC 10 this_ent)))) ) ;_ end of IF (SETQ tinpt_list (APPEND tinpt_list (LIST (CDR (ASSOC 11 this_ent))))) ) (T (SETQ tinpt_list NIL)) ) ;_ end of COND (SETQ cnt (1+ cnt)) ) ;_ end of WHILE (IF tinpt_list (PROGN (IF (EQ (SSLENGTH (SSGET "X" '((0 . "AECC_TIN_SURFACE")))) 1) (COMMAND "ADDSURFACEPOINT") (COMMAND "ADDSURFACEPOINT" "") ) ;_ end of IF (FOREACH n tinpt_list (COMMAND (LIST (CAR n) (CADR n) (CADDR n)) (CADDR n)) ) ;_ end of FOREACH ) ;_ end of PROGN (ALERT "No Circles or 3D Polylines were selected! ") ) ;_ end of IF (SETQ oldtinpt_list tinpt_list) (SETVAR "osmode" old_osmode) (SETQ *error* old_ptsby_error) (PRINC) ) ;_ end of DEFUN ;;;**************************************************************************** (DEFUN c:apbe () (c:addptsbyent)) ;|«Visual LISP© Format Options» (84 2 40 2 T "end of " 60 9 2 0 0 nil T nil T) ;*** DO NOT add text below the comment! ***|;