@Moshe-A Hello!
Since this post the code has changed rather significantly, I was able to get it to work properly but only in a 1" = 30'-0" scale by dividing the "offset" variable by 30. I'll resend the updated code and a drawing to better show how this is supposed to look. The initial problem I was running into was that the model space blocks kept coming in relative to 0,0,0 location in model space, so they were off by about 33' in comparison to the elevation markers in paperspace. That so far seems to have been resolved.
The idea is to automate our drawings to insert an elevation marker in paper space and an antenna block location in model space at a user specified location. The trouble I'm having now is trying to make it so that this code will work for any viewport scale and not just the 1" = 30'-0" scale.
(defun c:anttest ( / cb:M-Text mosPosVP psPos-to-msPos msPos-to-psPos cb:replaceAttributeValue ATTNAME ATTNEWVAL ELEVBLK GROUNDLEVEL MOSVP OFFSET POLVERTS PSBLOCKPOINT SELPT X offsetMutiplier MSBLOCKPOINT ANTBLK PAN1 PAN2 PAN3 PAN4 PROMSBLOCKPOINT PROANTBLK PROPSNOTEPOINT PROPAN1 PROPAN2 PROPAN3 PROPAN4 PRONOTEBLK PROPSBLOCKPOINT PROELEVBLK)
;; Set Dynamic Block Property Value - Lee Mac
;; Modifies the value of a Dynamic Block property (if present)
;; blk - [vla] VLA Dynamic Block Reference object
;; prp - [str] Dynamic Block property name (case-insensitive)
;; val - [any] New value for property
;; Returns: [any] New value if successful, else nil
(defun LM:setdynpropvalue ( blk prp val )
(setq prp (strcase prp))
(vl-some
'(lambda ( x )
(if (= prp (strcase (vla-get-propertyname x)))
(progn
(vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
(cond (val) (t))
)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
(defun mosPosVP(mosPos / retn ssVP);
(setq ssVP (ssget "x" (list (cons 0 "VIEWPORT")(cons 410 (getvar "CTAB"))(cons -4 "<not")(cons 69 1)(cons -4 "not>"))))
(if ssVP (foreach forVar (ssnamex ssvp)
(if (and (inpoly mosPos (vp-coords (cadr forVar))) (not retn))
(setq retn (cadr forVar)))))
retn
); Returns the viewport that mouse location is within or nil
(defun psPos-to-msPos(point vport / pt);
(setq pt (polar
'(0 0 0)
(+ (- (angle (trans point 3 2) '(0 0 0)) (cdr (assoc 51 (entget vport)))) pi)
(distance (trans point 3 2) '(0 0 0))
))
(list (+ (car pt) (car (cdr (assoc 17 (entget vport))))) (+ (cadr pt) (cadr (cdr (assoc 17 (entget vport))))) 0)
); Returns a modelspace point given a paperspace point and viewport
(defun msPos-to-psPos(point vport / pt);
(setq pt (list (- (car point) (car (cdr (assoc 17 (entget vport))))) (- (cadr point) (cadr (cdr (assoc 17 (entget vport))))) 0))
(polar
'(0 0 0)
(+ (- (angle (trans pt 2 3) '(0 0 0)) (cdr (assoc 51 (entget vport)))) pi)
(distance (trans pt 2 3) '(0 0 0))
)
); Returns a paperspace point given a modelspace point and viewport
;;;;;Replace Attribute Value;;;;;;;;;
;;;;;By: Zack Raboin;;;;;;;;;;;;;;;;;
;;;;;01/24/15;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;Send a block to this function with an attribute you want to replace with a new value
;;;;attName = the name of the attribute which value you want to replace
;;;;attNewVal = the new value you want in the attribute
;;;;Blk = the vla-object verision of the block which the attribute is in
(defun cb:replaceAttributeValue (attName attNewVal Blk / )
(mapcar '(lambda (x) (if (= attName (vla-get-tagstring x))
(vla-put-textstring x attNewVal))) (cb:variantToList (vla-getattributes Blk)))
(princ)
)
;Check to see If you are in model space
(if (= (getvar "ctab") "Model")
(princ "\nFunction cancelled - not applicable to Modelspace.") ;Cancel function if in model space
(progn ;If you are in paperSpace, Continue.
;;program start
(princ (strcat "\nSelect The Ground Level Line: "));Ask the user to select an object
(setq selPt '(7.90156 1.13064 0.0))
;(setq selPt (cadr (grread nil 4 2)));SET THE POINT THE USER SELECTS, REPLACE WITH THE CODE ABOVE TO SET USER BASED SELECTION.
(if (setq mosVP (mosPosVP selPt));if the selection point is in a viewport, run the program
;;***************************************************
;;;;;;;;;;;;;;INSERT "EXISTING MOUNTS";;;;;;;;;;;;;;;
;;***************************************************
(progn
(setq selPt (psPos-to-msPos selPt mosVP));convert selpt to a MS point
(setq groundLevel (get-ms-object mosVP selPT));get the modelspace object
(if (and groundLevel (wcmatch (cdr (assoc 0 (entget groundLevel))) "*LINE"));check to see if something was selected, and if that something was a *line
(while (setq offset (getreal "\nEnter Existing RAD Height: "))
(if (= (getvar "insunits") 2) ;insunits 2 = feet, insunits 1 = inches
(setq offsetMutiplier 1) ;offset by 1 "units" (feet) if insunits is equal to 2
(setq offsetMutiplier 12)) ;offset by 12 "units" (inches) if insunits is not equal to 2
; offset groundline after selection, set number of units (inches or feet)
;(vla-put-mspace (vla-get-activedocument (vlax-get-acad-object)) :vlax-true)
;(setvar "CVPORT" (cdr (assoc 69 (entget mosvp))))
(if (< (caar (setq polVerts (plverts groundLevel))) (caadr polverts))
(vla-offset (vlax-ename->vla-object groundLevel) (* (* -1 offsetMutiplier) offset))
(vla-offset (vlax-ename->vla-object groundLevel) (* offsetMutiplier offset))
)
(vla-put-layer (vlax-ename->vla-object (entlast)) "Defpoints")
(setq psBlockPoint (msPos-to-psPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (* offset offsetMutiplier)) mosVP))
;(vla-put-mspace (vla-get-activedocument (vlax-get-acad-object)) :vlax-false)
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 10.9375 (cdr psBlockPoint)) 1 0))
"ElevationMarker"
1.0 1.0 1.0 0.0
)
(setq ElevBlk (vlax-ename->vla-object (entlast)))
(cb:replaceAttributeValue "HEIGHT" (if (eq (rem offset 1) 0)
(strcat (rtos offset 2 0) "\'")
(strcat (rtos offset 2 1) "\'")) ElevBlk)
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CX-TEXT")
(LM:setdynpropvalue elevBlk "Lookup1" "Middle")
(setq selPt (msPos-to-psPos selPt mosVP));convert selpt to a PS point
(setq groundLevel (get-ms-object mosVP selPT));get the modelspace object
(if (< (caar (setq polVerts (plverts groundLevel))) (caadr polverts))
(vla-offset (vlax-ename->vla-object groundLevel) (* (* -1 offsetMutiplier) offset))
(vla-offset (vlax-ename->vla-object groundLevel) (* offsetMutiplier offset))
)
(vla-delete (vlax-ename->vla-object (entlast)))
(setq msBlockPoint (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP)) ;(/ OFFSET "VALUE OF VIEWPORT SCALE")
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 0 (cdr msBlockPoint)) 0 1))
"_Antenna Mount Elevation DB"
1.0 1.0 1.0 0.0
)
(setq AntBlk (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CX-EQPT")
(LM:setdynpropvalue AntBlk "Pipe Count" "4 pipes")
(command "_.REGEN")
;ADD CODE TO INSERT "EXISTING" PANELS ON MOUNTS, CREATE NEW MS BLOCK POINT VARIABLE
(setq Pan1 (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons -72 (cdr Pan1)) 0 1))
"_Antenna Elevation DB"
1.0 1.0 1.0 0.0
)
(setq Pan1 (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CX-EQPT")
(LM:setdynpropvalue Pan1 "Height" "84")
(LM:setdynpropvalue Pan1 "Width" "12")
(LM:setdynpropvalue Pan1 "Pipe Length" "96")
(command "_.REGEN")
(setq Pan2 (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons -24 (cdr Pan2)) 0 1))
"_Antenna Elevation DB"
1.0 1.0 1.0 0.0
)
(setq Pan2 (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CX-EQPT")
(LM:setdynpropvalue Pan2 "Height" "84")
(LM:setdynpropvalue Pan2 "Width" "12")
(LM:setdynpropvalue Pan2 "Pipe Length" "96")
(command "_.REGEN")
(setq Pan3 (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 24 (cdr Pan3)) 0 1))
"_Antenna Elevation DB"
1.0 1.0 1.0 0.0
)
(setq Pan3 (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CX-EQPT")
(LM:setdynpropvalue Pan3 "Height" "84")
(LM:setdynpropvalue Pan3 "Width" "12")
(LM:setdynpropvalue Pan3 "Pipe Length" "96")
(command "_.REGEN")
(setq Pan4 (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 72 (cdr Pan4)) 0 1))
"_Antenna Elevation DB"
1.0 1.0 1.0 0.0
)
(setq Pan4 (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CX-EQPT")
(LM:setdynpropvalue Pan4 "Height" "84")
(LM:setdynpropvalue Pan4 "Width" "12")
(LM:setdynpropvalue Pan4 "Pipe Length" "96")
(command "_.REGEN")
);while
);if
);progn
);if
);progn
);if
;;***************************************************************************
;;;;;;;;;;;;;;INSERT "PROPOSED MOUNTS";;;;;;;;;;;;;;;
;;***************************************************************************
;Check to see If you are in model space
(if (= (getvar "ctab") "Model")
(princ "\nFunction cancelled - not applicable to Modelspace.");Cancel function if in model space
(progn ;If you are in paperSpace, Continue.
;;program start
(princ (strcat "\nSelect The Ground Level Line: "));Ask the user to select an object
(setq selPt '(7.90156 1.13064 0.0))
;(setq selPt (cadr (grread nil 4 2)));set the point the user selects (replace code above to set user selection
(if (setq mosVP (mosPosVP selPt));if the selection point is in a viewport, run the program
(progn
(setq selPt (psPos-to-msPos selPt mosVP));convert selpt to a MS point
(setq groundLevel (get-ms-object mosVP selPT));get the modelspace object
(if groundLevel (wcmatch (cdr (assoc 0 (entget groundLevel))) "*LINE"));check to see if something was selected, and if that something was a *line
;(while ------------ ADD WHILE LOOP TO LINE BELOW IF PROPOSED WILL BE REQUIRED MORE THAN ONCE
(setq offset (getreal "\nEnter Proposed RAD Height: "))
(if (= (getvar "insunits") 2)
(setq offsetMutiplier 1)
(setq offsetMutiplier 12))
(if (< (caar (setq polVerts (plverts groundLevel))) (caadr polverts))
(vla-offset (vlax-ename->vla-object groundLevel) (* (* -1 offsetMutiplier) offset))
(vla-offset (vlax-ename->vla-object groundLevel) (* offsetMutiplier offset))
)
(vla-put-layer (vlax-ename->vla-object (entlast)) "Defpoints")
(setq PropsBlockPoint (msPos-to-psPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (* offset offsetMutiplier)) mosVP))
;(vla-put-mspace (vla-get-activedocument (vlax-get-acad-object)) :vlax-false)
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 10.9375 (cdr PropsBlockPoint)) 1 0))
"RAD HEIGHT EL LABEL"
1.0 1.0 1.0 0.0
)
(setq ProElevBlk (vlax-ename->vla-object (entlast)))
(cb:replaceAttributeValue "RAD_HEIGHT" (if (eq (rem offset 1) 0)
(strcat (rtos offset 2 0) "\'")
(strcat (rtos offset 2 1) "\'")) ProElevBlk)
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CX-TEXT")
(command "_.REGEN")
;ADD CODE TO INSERT NOTATION FOR PROPOSED EQUIPMENT, POINT AT PROPOSED MOUNT, CREATE NEW BLOCK PS POINT VARIABLE
(setq selPt (msPos-to-psPos selPt mosVP));convert selpt to a PS point
(setq groundLevel (get-ms-object mosVP selPT));get the modelspace object
(if (< (caar (setq polVerts (plverts groundLevel))) (caadr polverts))
(vla-offset (vlax-ename->vla-object groundLevel) (* (* -1 offsetMutiplier) offset))
(vla-offset (vlax-ename->vla-object groundLevel) (* offsetMutiplier offset))
)
(vla-delete (vlax-ename->vla-object (entlast)))
(setq PromsBlockPoint (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 0 (cdr PromsBlockPoint)) 0 1))
"_Antenna Mount Elevation DB"
1.0 1.0 1.0 0.0
)
(setq ProAntBlk (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CX-EQPT") ;"ATC_CP-EQPT" ------ PROPOSED LAYER MOUNT
(LM:setdynpropvalue ProAntBlk "Pipe Count" "4 pipes")
(command "_.REGEN")
;ADD CODE TO INSERT "PROPOSED" PANELS ON MOUNTS, CREATE NEW MS BLOCK POINT VARIABLE
(setq ProPan1 (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons -72 (cdr ProPan1)) 0 1))
"_Antenna Elevation DB"
1.0 1.0 1.0 0.0
)
(setq ProPan1 (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CP-EQPT")
(LM:setdynpropvalue ProPan1 "Height" "84")
(LM:setdynpropvalue ProPan1 "Width" "12")
(LM:setdynpropvalue ProPan1 "Pipe Length" "48")
(command "_.REGEN")
(setq ProPan2 (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons -24 (cdr ProPan2)) 0 1))
"_Antenna Elevation DB"
1.0 1.0 1.0 0.0
)
(setq ProPan2 (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CP-EQPT")
(LM:setdynpropvalue ProPan2 "Height" "84")
(LM:setdynpropvalue ProPan2 "Width" "12")
(LM:setdynpropvalue ProPan2 "Pipe Length" "48")
(command "_.REGEN")
(setq ProPan3 (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 24 (cdr ProPan3)) 0 1))
"_Antenna Elevation DB"
1.0 1.0 1.0 0.0
)
(setq ProPan3 (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CP-EQPT")
(LM:setdynpropvalue ProPan3 "Height" "84")
(LM:setdynpropvalue ProPan3 "Width" "12")
(LM:setdynpropvalue ProPan3 "Pipe Length" "48")
(command "_.REGEN")
(setq ProPan4 (psPos-to-msPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (/ offset 30)) mosVP))
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 0 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 72 (cdr ProPan4)) 0 1))
"_Antenna Elevation DB"
1.0 1.0 1.0 0.0
)
(setq ProPan4 (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "ATC_CP-EQPT")
(LM:setdynpropvalue ProPan4 "Height" "84")
(LM:setdynpropvalue ProPan4 "Width" "12")
(LM:setdynpropvalue ProPan4 "Pipe Length" "48")
(command "_.REGEN")
;);while ------------ ADD WHILE LOOP IF PROPOSED WILL BE REQUIRED MORE THAN ONCE
);progn
);if
);progn
);if
(setq PropsNotePoint (msPos-to-psPos (polar (vlax-curve-getclosestpointto groundLevel selPt) (* 90 (/ pi 180)) (* offset offsetMutiplier)) mosVP))
;(vla-put-mspace (vla-get-activedocument (vlax-get-acad-object)) :vlax-false)
(vla-insertblock
(vlax-get-property (vla-get-activedocument (vlax-get-acad-object)) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
(vlax-3D-point (trans (cons 6.785 (cdr PropsNotePoint)) 1 0))
"TMO TOWER NOTES"
1.0 1.0 1.0 0.0
)
(setq ProNote (vlax-ename->vla-object (entlast)))
(vla-put-layer (vlax-ename->vla-object (entlast)) "0")
(LM:setdynpropvalue ProNote "Visibility1" "EXST AND PROP ANTENNAS")
(LM:setdynpropvalue ProNote "Flip state1" 1)
(LM:setdynpropvalue ProNote "Position1 X" "0.3125")
(LM:setdynpropvalue ProNote "Position1 Y" "-0.125")
(princ)
(command "_.REGEN")
(princ)
);anttest