Leaderboard

didn't had time to post this until now so assumed dlanorh would have posted by now (and he didn't dissapoint haha) haven't looked at his code but I have no doubt it works just fine. Here's mine anyway. I don't do anything with the precision in my code but it shouldn't be hard to implement. (defun c:plo ( / coordinate-file-name coordinate-file-pointer sysvar-names sysvar-oldvalues fonth coord_name dec textline data) (defun _init () (vl-load-com) (setq sysvar-names (list (cons 'cmdecho 0)(cons 'dimzin 0)(cons 'osmode 0)(cons 'pdmode 34)) sysvar-oldvalues (mapcar '(lambda (x)(getvar (car x))) sysvar-names)) (mapcar '(lambda (x)(setvar (car x) (cdr x))) sysvar-names) ) (defun _exit () ; using this would also reset pdmode ;(mapcar '(lambda (x y)(setvar (car x) y)) sysvar-names sysvar-oldvalues) (if coordinate-file-pointer (close coordinate-file-pointer)) ) (defun *error* (msg) (princ msg) (_exit) (princ)) ;;; main body (_init) (cond ((not (setq coordinate-file-name (getfiled "Coordinate File" (getvar 'DWGPREFIX) "txt" 4))) (princ "\nNo coordinate file selected")) ((not (setq coordinate-file-pointer (open coordinate-file-name "r"))) (princ "\nUnable to read from coordinate file")) (t (initget "Y N") (or (setq coord_name (getkword "\nDo points in coordinate file have names? [<Yes>/No] :")) (setq coord_name "Y")) (setq fonth (getreal "\nEnter text height: ")) (setvar 'PDSIZE (/ fonth 2.0)) (setq dec (getint"\nEnter number of decimal places to round coords: ")) (command "-style" "°Point text" "swisscl.ttf" fonth 1 "" "" "" ) (check_layers) (while (setq textline (read-line coordinate-file-pointer)) (setq data (SplitStr (vl-string-trim " ," textline) ",")) (if (= (length data) 5) (place_point_with_code)(place_point_without_code)) ) (vl-cmdf "-layer" "off" "°Point3D" "") ) ) (vl-cmdf "_.zoom" "_e") (_exit) (princ) ) (defun place_point_with_code ( / point-num x y z point-code) (mapcar '(lambda (name value)(set name value)) '(point-num x y z point-code) data) (place_point_entity (list (atof x) (atof y))) (place_point_num (list (atof x) (atof y)) point-num) (place_point_h (list (atof x) (atof y)) z) (place_point_code (list (atof x) (atof y)) point-code) ) (defun place_point_without_code ( / point-num x y z) (mapcar '(lambda (name value)(set name value)) '(point-num x y z) data) (place_point_entity (list (atof x) (atof y))) (place_point_num (list (atof x) (atof y)) point-num) (place_point_h (list (atof x) (atof y)) z) ) (defun place_point_entity (point) (entmakex (list (cons 0 "POINT") (cons 10 point) (cons 8 "°Point2D")))) (defun place_point_num (point point-num / ip) (setq ip (polar point (* pi 0.45) (* fonth 0.5))) (entmakex (list (cons 0 "TEXT")(cons 1 point-num)(cons 8 "°Point NUM") (cons 10 ip) (cons 11 ip) (cons 40 fonth) (cons 72 0) (cons 73 2)))) (defun place_point_h (point point-h / ip) (setq ip (polar point (* pi -0.45) (* fonth 0.5))) (entmakex (list (cons 0 "TEXT")(cons 1 point-num)(cons 8 "°Point H") (cons 10 ip) (cons 11 ip) (cons 40 fonth)(cons 72 0) (cons 73 2)))) (defun place_point_code (point point-code / ip) (setq ip (polar point (* pi 0.55) (* fonth 0.5))) (entmakex (list (cons 0 "TEXT")(cons 1 point-num)(cons 8 "°Point CODE") (cons 10 ip) (cons 11 ip) (cons 40 fonth)(cons 72 2) (cons 73 2)))) (defun check_layers () (mapcar '(lambda (x) (create_layer (car x) (cadr x))) '(("°Point NUM" 3) ("°Point H" 2)("°Point CODE" 1)("°Point NOTE" 8)("°Point2D" 7)("°Point3D" 5)))) ; n = name, c = color (defun create_layer (n c) (if (and (snvalid n) (null (tblsearch "layer" n))) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 n) (cons 62 c) (cons 70 0) (cons 290 1))))) ;;; s = string d = delimiter p = position delimiter (thanx Lee Mac) (defun SplitStr ( s d / p ) (if (setq p (vl-string-search d s))(cons (substr s 1 p) (SplitStr (substr s (+ p 1 (strlen d))) d)) (list s)))

in place of atof you could use 'datof' (defun datof (s i / n ) (if (and (= (type s) 'str) (numberp i) (setq n (vl-string-position (ascii ".") s))) (substr s 1 (+ 1 i n)) s)) test (datof "12345.67890" 2) where 2 is the number of decimals (dec in your routine) if data integrity is guaranteed : (defun datof (s i) (substr s 1 (+ 1 i (vl-string-position (ascii ".") s))))

@Tomislav I've merged the lisps written by myself and @rlx into a new lisp. Please see attached. This uses @rlx entmake methods which should improve the speed. plo2.lsp

Yeah, get well soon sicco , oh sorry I mean dlanorh Hadn't really tested my code and saw I missed to place the point note (the gray one) so no wonder dlanorh code was a little slower. Not that I think adding it will make much difference in speed. I removed the initget and the decimal places from updated code below since I don't put them to use. But you can put'm back as you please... Anyways , think the little difference in speed is because of vanilla vs. visual lisp (entmake vs vlax-invoke). So maybe mine was faster (but incomplete) , maybe dlanorh's was better after all for what its worth , here's the updated code (which on my system only takes 2 or 3 seconds) (defun c:plo ( / fn fp vars vals fonth inp data) (defun _init () (vl-load-com) (setq vars (list (cons 'cmdecho 0) (cons 'dimzin 0) (cons 'osmode 0) (cons 'pdmode 34)) vals (mapcar '(lambda (x)(getvar (car x))) vars)) (mapcar '(lambda (x)(setvar (car x) (cdr x))) vars) ) (defun _exit () ; using this would also reset pdmode ;(mapcar '(lambda (x y)(setvar (car x) y)) vars vals) (if fp (close fp)) ) (defun *error* (msg) (princ msg) (_exit) (princ)) ;;; main body (_init) (cond ((not (setq fn (getfiled "Coordinate File" (getvar 'dwgprefix) "txt" 4))) (princ "\nNo coordinate file selected")) ((not (setq fp (open fn "r"))) (princ "\nUnable to read from coordinate file")) (t (setq fonth (getreal "\nEnter text height: ")) (setvar 'PDSIZE (/ fonth 2.0)) (command "-style" "°Point text" "swisscl.ttf" fonth 1 "" "" "" ) (check_layers) (while (setq inp (read-line fp)) (setq data (SplitStr (vl-string-trim " ," inp) ","))(place_point data)) (vl-cmdf "-layer" "off" "°Point3D" "") ) ) (vl-cmdf "_.zoom" "_e") (_exit) (princ) ) ; point-num , point-x , point-y, point-h , point-code, point-note (point-code & note not allways present) ; example data record : 6216,649349.322,5034388.831,94.145,48,25 (defun place_point ( data / point-num x y point-h point-code point-note) (mapcar '(lambda (name value)(set name value)) '(point-num x y point-h point-code point-note) data) (place_point_entity (list (atof x) (atof y))) (place_point_num (list (atof x) (atof y)) point-num) (place_point_h (list (atof x) (atof y)) point-h) (if point-code (place_point_code (list (atof x) (atof y)) point-code)) (if point-note (place_point_note (list (atof x) (atof y)) point-note)) ) (defun place_point_entity (point) (entmakex (list (cons 0 "POINT") (cons 10 point) (cons 8 "°Point2D")))) (defun place_point_num (point s / ip) (setq ip (polar point (* pi 0.45) (* fonth 0.5))) (entmakex (list (cons 0 "TEXT")(cons 1 s)(cons 8 "°Point NUM") (cons 10 ip) (cons 11 ip) (cons 40 fonth) (cons 72 0) (cons 73 2)))) (defun place_point_h (point s / ip) (setq ip (polar point (* pi -0.45) (* fonth 0.5))) (entmakex (list (cons 0 "TEXT")(cons 1 s)(cons 8 "°Point H") (cons 10 ip) (cons 11 ip) (cons 40 fonth)(cons 72 0) (cons 73 2)))) (defun place_point_code (point s / ip) (setq ip (polar point (* pi 0.55) (* fonth 0.5))) (entmakex (list (cons 0 "TEXT")(cons 1 s)(cons 8 "°Point CODE") (cons 10 ip) (cons 11 ip) (cons 40 fonth)(cons 72 2) (cons 73 2)))) (defun place_point_note (point s / ip) (setq ip (polar point (* pi 1.45) (* fonth 0.5))) (entmakex (list (cons 0 "TEXT")(cons 1 s)(cons 8 "°Point NOTE") (cons 10 ip) (cons 11 ip) (cons 40 fonth)(cons 72 2) (cons 73 2)))) (defun check_layers () (mapcar '(lambda (x) (create_layer (car x) (cadr x))) '(("°Point NUM" 3) ("°Point H" 2)("°Point CODE" 1)("°Point NOTE" 8)("°Point2D" 7)("°Point3D" 5)))) ; n = name, c = color (defun create_layer (n c) (if (and (snvalid n) (null (tblsearch "layer" n))) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 n) (cons 62 c) (cons 70 0) (cons 290 1))))) ;;; s = string d = delimiter p = position delimiter (thanx Lee Mac) (defun SplitStr ( s d / p ) (if (setq p (vl-string-search d s))(cons (substr s 1 p) (SplitStr (substr s (+ p 1 (strlen d))) d)) (list s)))

QSELECT>Block Reference>Name>*Wildcard Match>Smart Solid*

Open in the block editor or refedit in place and ATTDEF. You can copy and rename one of the others if you prefer, also.

well, I did some testing with all of these lisps and the results are interesting.. my test file consists of 8525 points and here are the results : 220s - my original lisp 90s - my lisp tweaked with some Jonathans advices 26s - dlanorh 11s - rlx after seeing this one must appreciate code optimisation...thank you all again p.s. I hope u get well dlanorh

For bf you need to copy bf lm:unique and bb:setbyblock then type bf to run it. Copy all of the below or download the attached. (defun LM:unique (l) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))) ;; set "by block" to all entities in block definition (defun BB:setByBlock (nam / blc blk) (setq blc (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))) (setq blk (vla-item blc nam)) (vlax-for x blk (if (= "0" (vlax-get-property x 'layer)) (vlax-put-property x 'lineweight acLnWtByBlock))) ) (vl-load-com) (defun c:bf ( / c_doc sel cnt obj col) (setq c_doc (vla-get-activedocument (vlax-get-acad-object))) (princ "\nSelect blocks : ") (setq sel (ssget '((0 . "INSERT")))) (cond (sel (repeat (setq cnt (sslength sel)) (setq obj (vlax-ename->vla-object (ssname sel (setq cnt (1- cnt))))) (cond ( (= :vlax-true (vlax-get-property obj 'isdynamicblock)) (setq col (cons (vla-get-effectivename obj) col) col (cons (vla-get-name obj) col) ) ) (t (setq col (cons (vla-get-effectiveName obx) col))) );end_cond );end_repeat (setq col (LM:unique col)) (foreach x col (BB:setByBlock x)) ) ( (princ "\nNothing Selected")) );end_cond (vla-regen c_doc acActiveViewport) (princ) ) bf.lsp

Bedit ? then attsync ? need more info.

YES!! I created the plant image in photoshop and saved/ imported as you said- flawless. I had forgotten about the imageframe setting command. Great thing with the photoshop opacity values, they carry through into autocad, so I can see overlapping data and understory plants under the tree symbols. Thank you! test1.pdf

In Photoshop, delete the white background, so only the tree remains, then save the tree as .png format. In Autocad, insert the tree image. Open the Properties palette and enable "Background Transparency". In the image below, I have also set the Imageframe variable to 0, so the image border is not visible.

That isn't a lot of information to work with, can you show us a dwg with a description of what you are trying to do.

Try the following routine and change the tag name that suits your desired one and regardless of any of the blocks that reside on locked layers. (defun c:Test (/ *error* doc tag lst sel int ent) ;;------------------------------------;; ;; Tharwat - Date: 03.Oct.2019 ;; ;; Change color of a certain attribute;; ;; based on its tag name to by layer. ;; ;;------------------------------------;; (defun *error* (msg) (and doc lst (foreach lay lst (vla-put-lock lay :vlax-true)) ) (and doc (vla-endundomark doc)) (and msg (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*") (princ (strcat "\nError =>: " msg)) ) (princ) ) ;; change the tag to suit yours. (setq tag "My_Tag") ;; ;; (vla-endundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))) ) (vla-startundomark doc) (vlax-for lay (vla-get-layers doc) (and (= (vla-get-lock lay) :vlax-true) (setq lst (cons lay lst)) (vla-put-lock lay :vlax-false) ) ) ;; ;; (and (setq int -1 sel (ssget "_X" '((0 . "INSERT") (66 . 1))) ) (while (setq int (1+ int) ent (ssname sel int) ) (foreach att (vlax-invoke (vlax-ename->vla-object ent) 'getattributes) (and (= (strcase (vla-get-tagstring att)) tag) (vla-put-color att AcBylayer) ) ) ) ) (*error* nil) (princ) ) (vl-load-com)

The following will operate autonomously on the active drawing, modifying all attributes with tags matching the supplied pattern at the top of the code (this accepts wildcards): (defun c:fixattcol ( / att atx col idx sel tag ) (setq tag "TAG1" ;; Attribute tag(s) to change col 256 ;; New colour tag (strcase tag) col (list (cons 62 col)) ) (if (setq sel (ssget "_X" '((0 . "INSERT") (66 . 1)))) (repeat (setq idx (sslength sel)) (setq idx (1- idx) att (entnext (ssname sel idx)) atx (entget att) ) (while (= "ATTRIB" (cdr (assoc 0 atx))) (if (wcmatch (strcase (cdr (assoc 2 atx))) tag) (if (entmod (append atx col)) (entupd att) ) ) (setq att (entnext att) atx (entget att) ) ) ) ) (princ) ) You can then run this across multiple drawings using my Script Writer program.