Message 1 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
(full in development code can be found below snippets)
I am writing a program to analyze my pole sheets based of certain rules to tell me if they have any safety violations.
To do this I must breakdown the the measurements taken from the field into inches. I am trying to utilize the mapcar function for this but it is not returning the expected value.
I have tested the code within the function convertToInches and it works... I'm just cleaning up the code so I can call the function convertToInches instead of copy and paste it in several areas within it needing to changes variables and such.
Trying to understand why the code below in red is not returning a list of inches within pwr_hgts_in
(setq pwr_hgts_in(mapcar 'convertToInches ' (pwr_hgts)))
(defun convertToInches ( listItem ) (setq listItem_in(vl-string-left-trim "-" (vl-string-left-trim "0123456789" listItem))) (setq listItem_ft(vl-string-right-trim "-" (vl-string-right-trim "0123456789" listItem))) (setq listItem (+ (* 12 (atoi listItem_ft)) (atoi listItem_in))) )
FULL CODE
;FMRP
;Description: A program determine if poles need make ready or not.
;pwg_hgts - list of pwr heights from attribute data
;( n sec dl r trns)
;pwg_hgts_in - list of pwr heights in inches
;( n sec dl r trns)
;lwst_pwr - contains lowest power measurement
;lwst_pwr_in- lowest power in inches.
;comm_hgts - list of communication heights from highest to lowest.
;comm_hgts_in - list of communication heights from highest to lowest in inches.
;comm_owners - list of communication facility owners
;diff = Difference between highest communication and lowest power.
;phoa = proposed height of attachment
(defun c:REC-FMRP ( /
profile_nu
pwr_hgts
pwr_hgts_in
lwst_pwr
lwst_pwr_in
comm_hgts
comm_hgts_in
comm_owners
diff
phoa
phoa_i
mr
i
j
p
s )
(prompt ";\n
;Description: A program to determine poles which will need make ready performed.
")
(setq p "ACMAP_ANN_TEMPLATE_REC_POLE_SHEET"; Block name pattern
p (strcase p)
)
(if (setq s
(ssget "_X"
(list
'(0 . "INSERT")
(cons 2
(strcat "`*U*," p)
)
)
)
);if blocks found and selection set is set
;keep the blocks vs the pattern provided
(repeat (setq i (sslength s))
(if
(not
(wcmatch
(strcase
(LM:blockname
(vlax-ename->vla-object
(ssname s
(setq i
(1- i)
)
)
)
);add to selection set
)
p
)
)
(ssdel (ssname s i) s) ;delete item - didn't match pattern
);if they do not match the pattern delete it from the selection set, if they do keep them
);iterate through the blocks
)
(if s
(repeat (setq j (sslength s)) ;iterate through the blocks
(setq j (1- j))
(setq profile_nu (LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "PROFILE_NU"))
(setq pwr_hgts
(list
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "N_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "SEC_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "DL_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "R_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "T_HGT")
)
)
(setq pwr_hgts (vl-remove "" pwr_hgts))
(setq pwr_hgts (ME:remove-nil pwr_hgts))
(setq pwr_hgts_in(mapcar 'convertToInches ' (pwr_hgts)))
(setq comm_owners
(list
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM1OWN")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM2OWN")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM3OWN")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM4OWN")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM5OWN")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM6OWN")
)
)
(setq comm_owners (vl-remove "" comm_owners))
(setq comm_owners (ME:remove-nil comm_owners))
(setq comm_hgts
(list
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM_1_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM_2_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM_3_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM_4_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM_5_HGT")
(LM:vl-getattributevalue (vlax-ename->vla-object (ssname s j)) "COM_6_HGT")
)
)
(setq comm_hgts (vl-remove "" comm_hgts))
(setq comm_hgts (ME:remove-nil comm_hgts))
(prompt (strcat "The lowest power / highest communication for " profile_nu " are " pwr_hgt " / " pvd_2_hgt " respectively\n"))
;get inches and feet sides of dash
(setq pwr_hgt_i(vl-string-left-trim "-" (vl-string-left-trim "0123456789" pwr_hgt)))
(setq pwr_hgt_f(vl-string-right-trim "-" (vl-string-right-trim "0123456789" pwr_hgt)))
(setq pvd_2_hgt_i(vl-string-left-trim "-" (vl-string-left-trim "0123456789" pvd_2_hgt)))
(setq pvd_2_hgt_f(vl-string-right-trim "-" (vl-string-right-trim "0123456789" pvd_2_hgt)))
;convert feet heights to inches and add the "i" variable respectively - reassign value to orginal vars
(setq pwr_hgt (+ (* 12 (atoi pwr_hgt_f)) (atoi pwr_hgt_i)))
(setq pvd_2_hgt (+ (* 12 (atoi pvd_2_hgt_f)) (atoi pvd_2_hgt_i)))
;set phoa and phoa_i
(setq phoa (strcat (itoa (/ (+ pvd_2_hgt 12) 12)) "-" (itoa (rem (+ pvd_2_hgt 12) 12))))
(setq phoa_i (+ pvd_2_hgt 12))
(prompt (strcat "The proposed HOA to test against for " profile_nu " is " phoa "\n"))
;calculate difference between phoa and lwst power
;if the difference is less than 40 flag for make ready
(if (< (- pwr_hgt phoa_i) 40)
(prompt (setq mr "Needs MR\n"))
(prompt (setq mr "No MR Needed\n"))
)
)
)
(princ)
);defun FMRP
;Lee Mac's orginial code edited from here... Answer -> http://www.cadtutor.net/forum/showthread.php?89306-Lisp-to-select-blocks-using-wildcard
(defun convertToInches ( listItem )
(setq listItem_in(vl-string-left-trim "-" (vl-string-left-trim "0123456789" listItem)))
(setq listItem_ft(vl-string-right-trim "-" (vl-string-right-trim "0123456789" listItem)))
(setq listItem (+ (* 12 (atoi listItem_ft)) (atoi listItem_in)))
)
;; Block Name - Lee Mac
;; Returns the true (effective) name of a supplied block reference
(defun LM:blockname ( obj )
(if (vlax-property-available-p obj 'effectivename)
(defun LM:blockname ( obj ) (vla-get-effectivename obj))
(defun LM:blockname ( obj ) (vla-get-name obj))
)
(LM:blockname obj)
)
(vl-load-com) (princ)
;; Get Attributes - Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<Tag> . <Value>) ... )
(defun LM:vl-getattributes ( blk )
(mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att)))
(vlax-invoke blk 'getattributes)
)
)
;; Get Attribute Value - Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:vl-getattributevalue ( blk tag )
(setq tag (strcase tag))
(vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att)))
(vlax-invoke blk 'getattributes)
)
)
;; Set Attribute Value - Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
(defun LM:vl-setattributevalue ( blk tag val )
(setq tag (strcase tag))
(vl-some
'(lambda ( att )
(if (= tag (strcase (vla-get-tagstring att)))
(progn (vla-put-textstring att val) val)
)
)
(vlax-invoke blk 'getattributes)
)
)
; remove nil from list
(defun ME:remove-nil ( a_list )
(apply 'append
(mapcar
'(lambda (item)
(if (not (null item))
(list item)
)
)
a_list)
)
)
Solved! Go to Solution.
